PSC article analysis Q1 - NORWAY

1. Hypothesis: PSC is associated with the gut microbiome changes.

Pre_LTx vs Post_LTx vs Healthy analysis on merged data

• Alpha diversity –> group effect, country effect, interaction effect

• Beta diversity – PERMANOVA, PCA -> group effect, country effect, interaction effect

• DAA ->

  • o Group effect – linDA + MaAsLin2 intersection

  • o Country effect – linDA + MaAsLin2 union

Pre_ltx vs Healthy – by this comparison, we will find the effect of disease, liver cirrhosis and overall bad clinical condition

Pre_ltx vs post_ltx – by this comparison, we will find the effect of transplantation + general improvement of the clinical state

Post_ltx vs Healthy – by this comparison, we will find if the transplantation leads to „healthy microbiome”

TO DO —- Hopefully, we will find that all of these groups are somehow significantly different.

Regarding Post_LTx vs Healthy analysis, we can assume, that the differentially abundant taxa between these two groups remain because of the persistent gut MB alteration due to the PSC disease. Also, transplantation itself could add to this difference, as it has definitely strong impact on microbial composition.

Regarding Pre_LTx vs Healthy analysis, we can assume, that the differentially abundant taxa between these two groups are caused by PSC disease and other factors, like liver cirrhosis and overall bad clinical condition. To get only PSC associated taxa, we can intersect differentially abundant taxa from these aforementioned analyses (see diagram below).

imagename

TO DO: IMPORTOVAT TABULKU 1

source("custom_functions.R")

Data Import

Importing ASV, taxa and metadata tables for both Czech and Norway samples.

Norway

path = "../../data/analysis_ready_data/norway/"
asv_tab_norway <- as.data.frame(fread(file.path(path,"asv_table_norway.csv"),
                                    check.names = FALSE))
taxa_tab_norway <- as.data.frame(fread(file.path(path,"taxa_table_norway.csv"),
                                    check.names = FALSE))
metadata_norway <- as.data.frame(fread(file.path(path,"metadata_norway.csv"),
                                    check.names = FALSE))

Spliting to segments

TO DO: STATISTICS OF READS

Merging two countries based on the different matrices - Ileum, Colon.

Terminal ileum

ileum_data <- merging_data(asv_tab_1=asv_tab_norway,
                           asv_tab_2=NULL,
                           taxa_tab_1=taxa_tab_norway,
                           taxa_tab_2=NULL,
                           metadata_1=metadata_norway,
                           metadata_2=NULL,
                           segment="TI",Q="Q1")

## Removing 1834 ASV(s)

ileum_asv_tab <- ileum_data[[1]]
ileum_taxa_tab <- ileum_data[[2]]
ileum_metadata <- ileum_data[[3]]

Colon

colon_data <- merging_data(asv_tab_1=asv_tab_norway,
                           asv_tab_2=NULL,
                           taxa_tab_1=taxa_tab_norway,
                           taxa_tab_2=NULL,
                           metadata_1=metadata_norway,
                           metadata_2=NULL,
                           segment="colon",Q="Q1")

## Removing 266 ASV(s)

colon_asv_tab <- colon_data[[1]]
colon_taxa_tab <- colon_data[[2]]
colon_metadata <- colon_data[[3]]

Data Analysis - Terminal ileum

segment="terminal_ileum"

Filtering

Rules: - prevalence > 5% (per group) - nearZeroVar with default settings - sequencing depth > 5000 - taxonomic assignment at least order

Library size

read_counts(ileum_asv_tab, line = c(5000,10000))

## Scale for y is already present.
## Adding another scale for y, which will replace the existing scale.

Sequencing depth

data_filt <- seq_depth_filtering(ileum_asv_tab,
                                 ileum_taxa_tab,
                                 ileum_metadata,
                                 seq_depth_threshold = 10000)

## Removing 97 ASV(s)

filt_ileum_asv_tab <- data_filt[[1]]; alpha_ileum_asv_tab <- filt_ileum_asv_tab
filt_ileum_taxa_tab <- data_filt[[2]]; alpha_ileum_taxa_tab <- filt_ileum_taxa_tab
filt_ileum_metadata <- data_filt[[3]]; alpha_ileum_metadata <- filt_ileum_metadata

seq_step <- dim(filt_ileum_asv_tab)[1]

Library size

read_counts(filt_ileum_asv_tab,line = c(5000,10000))

## Scale for y is already present.
## Adding another scale for y, which will replace the existing scale.

NearZeroVar

data_filt <- nearzerovar_filtering(filt_ileum_asv_tab, 
                                   filt_ileum_taxa_tab,
                                   filt_ileum_metadata)

filt_ileum_asv_tab <- data_filt[[1]]
filt_ileum_taxa_tab <- data_filt[[2]]
nearzero_step <- dim(filt_ileum_asv_tab)[1]

Library size

read_counts(filt_ileum_asv_tab,line = c(5000,10000))

## Scale for y is already present.
## Adding another scale for y, which will replace the existing scale.

Final Counts

final_counts_filtering(ileum_asv_tab,
                       filt_ileum_asv_tab,
                       filt_ileum_metadata,
                       seq_step, 0, nearzero_step) %>% `colnames<-`("Count")

Alpha diversity

path = "../results/Q1_norway/alpha_diversity"

Calculation

# Construct MPSE object
alpha_ileum_metadata$Sample <- alpha_ileum_metadata$SampleID
ileum_mpse <- as.MPSE(construct_phyloseq(alpha_ileum_asv_tab,
                                         alpha_ileum_taxa_tab,
                                         alpha_ileum_metadata))

ileum_mpse %<>% mp_rrarefy(raresize = 10000,seed = 123)

# Calculate alpha diversity - rarefied counts
ileum_mpse %<>% mp_cal_alpha(.abundance=RareAbundance, force=TRUE)

alpha_div_plots <- list()

# preparing data frame
alpha_data <- data.frame(SampleID=ileum_mpse$Sample.x,
                         Observe=ileum_mpse$Observe,
                         Shannon=ileum_mpse$Shannon,
                         Simpson=ileum_mpse$Simpson,
                         Pielou=ileum_mpse$Pielou,
                         Group=ileum_mpse$Group,
                         Country=ileum_mpse$Country)

write.csv(alpha_data,file.path(path,paste0("alpha_indices_",segment,".csv")),
          row.names = FALSE)

Plots

Custom plot

alpha_data <- alpha_data %>% 
  dplyr::select(-c("Simpson","Pielou")) %>%
  mutate(Richness=Observe)

p_A <- alpha_diversity_custom_2(alpha_data,
                                size = 1.5,
                                width = 0.3)

## Scale for y is already present.
## Adding another scale for y, which will replace the existing scale.
## Scale for y is already present.
## Adding another scale for y, which will replace the existing scale.

# save the results
alpha_div_plots[[paste(segment,"Custom")]] <- p_A

p_A

Linear Model

path = "../results/Q1_norway/alpha_diversity"
alpha_data <- read.csv(file.path(path,paste0("alpha_indices_",segment,".csv")))

Richness

results_model <- pairwise.lm(formula = "Observe ~ Group",
                             factors=alpha_data$Group,
                             data=alpha_data)

# check interaction
if (!is.data.frame(results_model)){
  results_model_observe <- results_model[[1]]
  results_model_observe_emeans <- results_model[[2]]
} else {
  results_model_observe <- results_model
  results_model_observe_emeans <- NA
}

# save the results
pc_observed <- list(); 
pc_observed[[segment]] <- results_model_observe

# see the results
knitr::kable(results_model_observe,digits = 3,
caption = "Raw results of linear model of richness estimation.")

Raw results of linear model of richness estimation.

	Estimate	Std..Error	t.value	Pr…t..	p.adj	sig
healthy vs Grouppre_ltx	-48.135	9.159	-5.255	0.000	0.000	***
pre_ltx vs Grouppost_ltx	-9.615	10.545	-0.912	0.365	0.365
healthy vs Grouppost_ltx	-57.750	11.334	-5.095	0.000	0.000	***

# see the results
knitr::kable(results_model[[3]],digits = 3,
caption = "Group means")

Group means

	Estimate	Std. Error	t value	Pr(>|t|)
healthy	179.222	8.014	22.363	0
pre_ltx	131.087	6.987	18.762	0
healthy	179.222	6.860	26.125	0

Shannon

results_model <- pairwise.lm(formula = "Shannon ~ Group",
                             factors=alpha_data$Group,
                             data=alpha_data)

# check interaction
if (!is.data.frame(results_model)){
  results_model_shannon <- results_model[[1]]
  results_model_shannon_emeans <- results_model[[2]]
} else {
  results_model_shannon <- results_model
  results_model_shannon_emeans <- NA
}

# save the results
pc_shannon <- list(); 
pc_shannon[[segment]] <- as.data.frame(results_model_shannon)

# see the results
knitr::kable(results_model_shannon,digits = 3,
caption = "Raw results of linear model of Shannon estimation.")

Raw results of linear model of Shannon estimation.

	Estimate	Std..Error	t.value	Pr…t..	p.adj	sig
healthy vs Grouppre_ltx	-0.363	0.125	-2.913	0.005	0.007	**
pre_ltx vs Grouppost_ltx	-0.128	0.146	-0.880	0.382	0.382
healthy vs Grouppost_ltx	-0.492	0.140	-3.521	0.001	0.002	**

# see the results
knitr::kable(results_model[[3]],digits = 3,
caption = "Group means")

Group means

	Estimate	Std. Error	t value	Pr(>|t|)
healthy	3.608	0.099	36.525	0
pre_ltx	3.244	0.097	33.572	0
healthy	3.608	0.093	38.599	0

Simpson

results_model <- pairwise.lm(formula = "Simpson ~ Group",
                                     factors=alpha_data$Group,
                                     data=alpha_data)

# check interaction
if (!is.data.frame(results_model)){
  results_model_simpson <- results_model[[1]]
  results_model_simpson_emeans <- results_model[[2]]
} else {
  results_model_simpson <- results_model
  results_model_simpson_emeans <- NA
}


# save the results
pc_simpson <- list(); 
pc_simpson[[segment]] <- as.data.frame(results_model_simpson)

# see the results
knitr::kable(results_model_simpson,digits = 3,
caption = "Raw results of linear model of Simpson estimation.")

Raw results of linear model of Simpson estimation.

	Estimate	Std..Error	t.value	Pr…t..	p.adj	sig
healthy vs Grouppre_ltx	-0.019	0.015	-1.303	0.196	0.261
pre_ltx vs Grouppost_ltx	-0.023	0.020	-1.133	0.261	0.261
healthy vs Grouppost_ltx	-0.042	0.020	-2.135	0.036	0.109

# see the results
knitr::kable(results_model[[3]],digits = 3,
caption = "Group means")

Group means

	Estimate	Std. Error	t value	Pr(>|t|)
healthy	0.926	0.014	65.903	0
pre_ltx	0.907	0.014	67.047	0
healthy	0.926	0.011	83.413	0

Pielou

results_model <- pairwise.lm(formula = "Pielou ~ Group",
                                     factors=alpha_data$Group,
                                     data=alpha_data)

# check interaction

if (!is.data.frame(results_model)){
  results_model_pielou <- results_model[[1]]
  results_model_pielou_emeans <- results_model[[2]]
} else {
  results_model_pielou <- results_model
  results_model_pielou_emeans <- NA
}

# save the results
pc_pielou <- list(); 
pc_pielou[[segment]] <- as.data.frame(results_model_pielou)

# see the results
knitr::kable(results_model_pielou,digits = 3,
caption = "Raw results of linear model of Pielou estimation.")

Raw results of linear model of Pielou estimation.

	Estimate	Std..Error	t.value	Pr…t..	p.adj	sig
healthy vs Grouppre_ltx	-0.03	0.019	-1.528	0.130	0.196
pre_ltx vs Grouppost_ltx	-0.01	0.022	-0.462	0.645	0.645
healthy vs Grouppost_ltx	-0.04	0.020	-1.953	0.055	0.165

# see the results
knitr::kable(results_model[[3]],digits = 3,
caption = "Group means")

Group means

	Estimate	Std. Error	t value	Pr(>|t|)
healthy	0.698	0.014	48.553	0
pre_ltx	0.668	0.014	46.236	0
healthy	0.698	0.015	48.077	0

Saving results

alpha_list <- list(
  Richness=pc_observed[[segment]] %>% rownames_to_column("Comparison"),
  Shannon=pc_shannon[[segment]] %>% rownames_to_column("Comparison"),
  Simpson=pc_simpson[[segment]] %>% rownames_to_column("Comparison"),
  Pielou=pc_pielou[[segment]] %>% rownames_to_column("Comparison"))
                   
write.xlsx(alpha_list, 
           file = file.path(path,paste0("alpha_diversity_results_",segment,".xlsx")))

Beta diversity

Calculating Aitchison distance (euclidean distance on clr-transformed data), both at ASV and genus level.

Main analysis - Genus, Aitchison

Genus level, Aitchison distance

level="genus"

path = "../results/Q1_norway/beta_diversity"

pairwise_aitchison_raw <- list()
pca_plots_list <- list()

Aggregation, filtering

# Aggregation
genus_data <- aggregate_taxa(ileum_asv_tab,
                             ileum_taxa_tab,
                             taxonomic_level=level,
                             names=TRUE)
# Filtration
filt_data <- filtering_steps(genus_data[[1]],
                             genus_data[[2]],
                             ileum_metadata,
                             seq_depth_threshold=10000)

## Removing 6 ASV(s)

filt_ileum_genus_tab <- filt_data[[1]]
filt_ileum_genus_taxa <- filt_data[[2]]
filt_ileum_metadata_genus <- filt_data[[3]]

PERMANOVA

pairwise_df <- filt_ileum_genus_tab %>% column_to_rownames("SeqID") %>% t()

# main effect
pp_main <- pairwise.adonis(pairwise_df,filt_ileum_metadata_genus$Group,
                           covariate = NULL, 
                           sim.method = "robust.aitchison", p.adjust.m="BH")


# tidy the results
pp_factor <- pp_main

cols <- c("pairs","Df","SumsOfSqs", "F.Model","R2","p.value", "p.adjusted", "sig")
colnames(pp_factor) <- cols

# save raw results
pairwise_aitchison_raw[[paste(level, segment)]] <- pp_factor

# see the results
knitr::kable(pp_factor,digits = 3,caption = "PERMANOVA, GROUP separation")

PERMANOVA, GROUP separation

pairs	Df	SumsOfSqs	F.Model	R2	p.value	p.adjusted	sig
pre_ltx vs healthy	1	655.253	3.824	0.046	0.001	0.001	***
pre_ltx vs post_ltx	1	369.482	2.092	0.025	0.001	0.001	***
post_ltx vs healthy	1	646.498	3.916	0.053	0.001	0.001	***

Plots

Custom

p <- pca_plot_custom(filt_ileum_genus_tab,
                                 filt_ileum_genus_taxa,
                                 filt_ileum_metadata_genus,
                                 show_boxplots = TRUE,
                                 variable = "Group", size=3, show_legend=TRUE)

# save the results
pca_plots_list[[paste(segment,level,"custom")]] <- p

# see the results
p

Saving results

write.xlsx(pairwise_aitchison_raw[[paste(level, segment)]], 
           file = file.path(path,
           paste0("beta_diversity_results_", segment,".xlsx")))

Supplementary analysis

supplements_beta <- list()

Genus level

level="genus"

Bray-Curtis

PERMANOVA

pairwise_df <- filt_ileum_genus_tab %>% column_to_rownames("SeqID") %>% t()

# main effect
pp_main <- pairwise.adonis(pairwise_df,filt_ileum_metadata_genus$Group,
                           covariate = NULL, 
                           sim.method = "bray", p.adjust.m="BH")


# tidy the results
pp_factor <- pp_main

cols <- c("pairs","Df","SumsOfSqs", "F.Model","R2","p.value", "p.adjusted", "sig")
colnames(pp_factor) <- cols

# save raw results
supplements_beta[[paste("bray",level,segment)]] <- pp_factor

# see the results
knitr::kable(pp_factor,digits = 3,caption = "PERMANOVA, GROUP separation")

PERMANOVA, GROUP separation

pairs	Df	SumsOfSqs	F.Model	R2	p.value	p.adjusted	sig
pre_ltx vs healthy	1	1.000	5.257	0.062	0.001	0.002	**
pre_ltx vs post_ltx	1	0.442	2.053	0.025	0.011	0.011	*
post_ltx vs healthy	1	1.165	6.012	0.079	0.001	0.002	**

Plots

p <- pca_plot_custom(filt_ileum_genus_tab,
                                 filt_ileum_genus_taxa,
                                 filt_ileum_metadata_genus,
                                 measure = "bray",
                                 show_boxplots = TRUE,
                                 variable = "Group", size=3, show_legend=TRUE)

# save the results
supplements_beta[[paste("PCoA bray",level,segment)]] <- p

# see the results
p

Jaccard

PERMANOVA

pairwise_df <- filt_ileum_genus_tab %>% column_to_rownames("SeqID") %>% t()

# main effect
pp_main <- pairwise.adonis(pairwise_df,filt_ileum_metadata_genus$Group,
                           covariate = NULL, 
                           sim.method = "jaccard", p.adjust.m="BH")


# tidy the results
pp_factor <- pp_main

cols <- c("pairs","Df","SumsOfSqs", "F.Model","R2","p.value", "p.adjusted", "sig")
colnames(pp_factor) <- cols

# save raw results
supplements_beta[[paste("jaccard",level,segment)]] <- pp_factor

# see the results
knitr::kable(pp_factor,digits = 3,caption = "PERMANOVA, GROUP separation")

PERMANOVA, GROUP separation

pairs	Df	SumsOfSqs	F.Model	R2	p.value	p.adjusted	sig
pre_ltx vs healthy	1	1.114	4.010	0.048	0.001	0.002	**
pre_ltx vs post_ltx	1	0.512	1.694	0.021	0.013	0.013	*
post_ltx vs healthy	1	1.225	4.313	0.058	0.001	0.002	**

Plots

Custom

p <- pca_plot_custom(filt_ileum_genus_tab,
                                 filt_ileum_genus_taxa,
                                 filt_ileum_metadata_genus,
                                 measure = "jaccard",
                                 show_boxplots = TRUE,
                                 variable = "Group", size=3, show_legend=TRUE)

# save the results
supplements_beta[[paste("PCoA jaccard",level,segment)]] <- p

# see the results
p

ASV level

level="ASV"

Aitchison

PERMANOVA

# preparing data frame
pairwise_df <- filt_ileum_asv_tab %>% column_to_rownames("SeqID") %>% t()

# main effect
pp_main <- pairwise.adonis(pairwise_df,filt_ileum_metadata$Group,
                           covariate = NULL, 
                           sim.method = "robust.aitchison", p.adjust.m="BH")


# tidy the results
pp_factor <- pp_main

cols <- c("pairs","Df","SumsOfSqs", "F.Model","R2","p.value", "p.adjusted", "sig")
colnames(pp_factor) <- cols

# save raw results
supplements_beta[[paste("aitchison",level,segment)]] <- pp_factor

# see the results
knitr::kable(pp_factor,digits = 3,caption = "PERMANOVA, GROUP separation")

PERMANOVA, GROUP separation

pairs	Df	SumsOfSqs	F.Model	R2	p.value	p.adjusted	sig
pre_ltx vs healthy	1	1022.375	3.249	0.039	0.001	0.001	***
pre_ltx vs post_ltx	1	500.838	1.753	0.021	0.001	0.001	***
post_ltx vs healthy	1	975.120	3.241	0.044	0.001	0.001	***

PCoA

p <- pca_plot_custom(filt_ileum_asv_tab,
                           filt_ileum_taxa_tab,
                           filt_ileum_metadata,
                           show_boxplots = TRUE,
                           variable = "Group", size=3, show_legend=TRUE)

# save the results
supplements_beta[[paste("PCoA aitchison",level,segment)]] <- p

# see the results
p

Bray-Curtis

PERMANOVA

# preparing data frame
pairwise_df <- filt_ileum_asv_tab %>% column_to_rownames("SeqID") %>% t()

# main effect
pp_main <- pairwise.adonis(pairwise_df,filt_ileum_metadata$Group,
                           covariate = NULL, 
                           sim.method = "bray", p.adjust.m="BH")


# tidy the results
pp_factor <- pp_main

cols <- c("pairs","Df","SumsOfSqs", "F.Model","R2","p.value", "p.adjusted", "sig")
colnames(pp_factor) <- cols

# save raw results
supplements_beta[[paste("bray",level,segment)]] <- pp_factor

# see the results
knitr::kable(pp_factor,digits = 3,caption = "PERMANOVA, GROUP separation")

PERMANOVA, GROUP separation

pairs	Df	SumsOfSqs	F.Model	R2	p.value	p.adjusted	sig
pre_ltx vs healthy	1	1.502	4.843	0.057	0.001	0.002	**
pre_ltx vs post_ltx	1	0.648	1.964	0.024	0.004	0.004	**
post_ltx vs healthy	1	1.599	5.137	0.068	0.001	0.002	**

PCoA

p <- pca_plot_custom(filt_ileum_asv_tab,
                     filt_ileum_taxa_tab,
                     filt_ileum_metadata,
                     measure = "bray",
                     show_boxplots = TRUE,
                     variable = "Group", size=3, show_legend=TRUE)

# save the results
supplements_beta[[paste("PCoA bray",level,segment)]] <- p

# see the results
p

Jaccard

PERMANOVA

# preparing data frame
pairwise_df <- filt_ileum_asv_tab %>% column_to_rownames("SeqID") %>% t()

# main effect
pp_main <- pairwise.adonis(pairwise_df,filt_ileum_metadata$Group,
                           covariate = NULL, 
                           sim.method = "jaccard", p.adjust.m="BH")


# tidy the results
pp_factor <- pp_main

cols <- c("pairs","Df","SumsOfSqs", "F.Model","R2","p.value", "p.adjusted", "sig")
colnames(pp_factor) <- cols

# save raw results
supplements_beta[[paste("jaccard",level,segment)]] <- pp_factor

# see the results
knitr::kable(pp_factor,digits = 3,caption = "PERMANOVA, GROUP separation")

PERMANOVA, GROUP separation

pairs	Df	SumsOfSqs	F.Model	R2	p.value	p.adjusted	sig
pre_ltx vs healthy	1	1.275	3.334	0.040	0.001	0.002	**
pre_ltx vs post_ltx	1	0.626	1.579	0.019	0.003	0.003	**
post_ltx vs healthy	1	1.319	3.438	0.047	0.001	0.002	**

PCoA

p <- pca_plot_custom(filt_ileum_asv_tab,
                     filt_ileum_taxa_tab,
                     filt_ileum_metadata,
                     measure = "jaccard",
                     show_boxplots = TRUE,
                     variable = "Group", size=3, show_legend=TRUE)

# save the results
supplements_beta[[paste("PCoA jaccard",level,segment)]] <- p

# see the results
p

Saving results

write.xlsx(supplements_beta[!grepl("PCoA",names(supplements_beta))],
           file = file.path(path,
           paste0("supplements_beta_diversity_", segment,".xlsx")))

Univariate Analysis

Main - Genus level

level="genus"

# needed paths
path = "../results/Q1_norway/univariate_analysis"
path_maaslin=file.path("../intermediate_files/maaslin/Q1_norway",level)

# variables
raw_linda_results_genus <- list();
raw_linda_results_genus[[segment]] <- list()
linda_results_genus <- list(); 
linda_results_genus[[segment]] <- list()

# country and interaction problems
list_country_union <- list()
list_intersections <- list()
list_venns <- list()
uni_statistics <- list()

# workbook for final df
wb <- createWorkbook()

# PSC effect
psc_effect <- list()

Aggregate taxa

genus_data <- aggregate_taxa(ileum_asv_tab,
                             ileum_taxa_tab,
                             taxonomic_level = level)

ileum_genus_tab <- genus_data[[1]]
ileum_genus_taxa_tab <- genus_data[[2]]

ileum_genus_asv_taxa_tab <- create_asv_taxa_table(ileum_genus_tab,
                                                  ileum_genus_taxa_tab)

pre_ltx vs healthy

group <- c("healthy","pre_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

linDA

# prepare the data
linda_data <- binomial_prep(ileum_genus_tab,
                            ileum_genus_taxa_tab,
                            ileum_metadata,
                            group, usage="linDA")

## Removing 37 ASV(s)

## Removing 6 ASV(s)

filt_ileum_uni_data <- linda_data[[1]]
filt_ileum_uni_taxa <- linda_data[[2]]
filt_ileum_uni_metadata <- linda_data[[3]]

# fit the model
linda.obj <- linda(filt_ileum_uni_data, 
                   filt_ileum_uni_metadata, 
                   formula = '~ Group')

## 0  features are filtered!
## The filtered data has  82  samples and  206  features will be tested!

## Warning in linda(filt_ileum_uni_data, filt_ileum_uni_metadata, formula = "~ Group"): Some features have less than 3 nonzero values! 
##                      They have virtually no statistical power. You may consider filtering them in the analysis!

## Pseudo-count approach is used.
## Fit linear models ...
## Completed.

linda.output <- linda.obj$output
linda.output <- linda_renaming(linda.output, group)

# save the results
group1 <- paste0(group[1], " vs ","Group",group[2])

for (grp in c(group1)){
  raw_linda_results_genus[[segment]][[grp]] <- 
    rawlinda.df(linda.output,
                grp,
                filt_ileum_uni_data,
                filt_ileum_uni_taxa)
  
  linda_results_genus[[segment]][[grp]] <- 
    linda.df(linda.output,
             grp,
             filt_ileum_uni_data,
             filt_ileum_uni_taxa)
}

# volcano plot
volcano_1 <- volcano_plot_linda(linda.output, 
                                group1, 
                                taxa_table = filt_ileum_uni_taxa) + 
            ggtitle(comparison_name)

volcano <- ggarrange(volcano_1)
volcano

## Warning: ggrepel: 24 unlabeled data points (too many overlaps). Consider increasing max.overlaps

MaAsLin2

volcano1 <- volcano_plot_maaslin(fit_data,filt_ileum_uni_taxa) + 
            ggtitle(comparison_name)

volcano <- ggarrange(volcano1)

## Warning: Removed 23 rows containing missing values or values outside the scale range (`geom_text_repel()`).

volcano

Group - Intersection

intersection_results <- group_intersection(group, list_intersections, list_venns,
                                           linda.output, fit_data,
                                           raw_linda_results_genus, 
                                           segment = segment,
                                           level=level)

list_intersections <- intersection_results[[1]]
list_venns <- intersection_results[[2]]
venn <- intersection_results[[3]]

# show the results
venn

Basic statistics

uni_df <-  merge(basic_univariate_statistics(linda_data,group),
                 raw_linda_results_genus[[segment]][[group1]],
                 by="SeqID",all=TRUE)

## [1] "healthy"
## [1] "pre_ltx"
## [1] "healthy"
## [1] "pre_ltx"

uni_df[["final_sig"]] <- uni_df$SeqID %in% list_intersections[[paste(segment,level,comparison_name)]][["SeqID"]]
uni_statistics[[segment]][[paste(level,comparison_name)]] <- uni_df

# for comparison
new_name <- comparison_name
addWorksheet(wb, sheetName = new_name)
writeData(wb, sheet = new_name, uni_df, rowNames=FALSE)

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

linDA

# prepare the data
linda_data <- binomial_prep(ileum_genus_tab,
                            ileum_genus_taxa_tab,
                            ileum_metadata,
                            group, usage="linDA")

## Removing 30 ASV(s)

## Removing 5 ASV(s)

filt_ileum_uni_data <- linda_data[[1]]
filt_ileum_uni_taxa <- linda_data[[2]]
filt_ileum_uni_metadata <- linda_data[[3]]

# fit the model
linda.obj <- linda(filt_ileum_uni_data, 
                   filt_ileum_uni_metadata, 
                   formula = '~ Group')

## 0  features are filtered!
## The filtered data has  82  samples and  207  features will be tested!
## Pseudo-count approach is used.
## Fit linear models ...
## Completed.

linda.output <- linda.obj$output
linda.output <- linda_renaming(linda.output, group)

# save the results
group1 <- paste0(group[1], " vs ","Group",group[2])

for (grp in c(group1)){
  raw_linda_results_genus[[segment]][[grp]] <- 
    rawlinda.df(linda.output,
                grp,
                filt_ileum_uni_data,
                filt_ileum_uni_taxa)
  
  linda_results_genus[[segment]][[grp]] <- 
    linda.df(linda.output,
             grp,
             filt_ileum_uni_data,
             filt_ileum_uni_taxa)
}

# volcano plot
volcano_1 <- volcano_plot_linda(linda.output, 
                                group1, 
                                taxa_table = filt_ileum_uni_taxa) + 
            ggtitle(comparison_name)


volcano <- ggarrange(volcano_1)
volcano

MaAsLin2

volcano1 <- volcano_plot_maaslin(fit_data,filt_ileum_uni_taxa) + 
            ggtitle(comparison_name)

volcano <- ggarrange(volcano1)

## Warning: Removed 3 rows containing missing values or values outside the scale range (`geom_text_repel()`).

volcano

Group - Intersection

intersection_results <- group_intersection(group, list_intersections, list_venns,
                                           linda.output, fit_data,
                                           raw_linda_results_genus, 
                                           segment = segment,
                                           level=level)

list_intersections <- intersection_results[[1]]
list_venns <- intersection_results[[2]]
venn <- intersection_results[[3]]

# show the results
venn

Basic statistics

uni_df <-  merge(basic_univariate_statistics(linda_data,group),
                 raw_linda_results_genus[[segment]][[group1]],
                 by="SeqID",all=TRUE)

## [1] "pre_ltx"
## [1] "post_ltx"
## [1] "pre_ltx"
## [1] "post_ltx"

uni_df[["final_sig"]] <- uni_df$SeqID %in% list_intersections[[paste(segment,level,comparison_name)]][["SeqID"]]
uni_statistics[[segment]][[paste(level,comparison_name)]] <- uni_df

# for comparison
new_name <- comparison_name
addWorksheet(wb, sheetName = new_name)
writeData(wb, sheet = new_name, uni_df, rowNames=FALSE)

post_ltx vs healthy

group <- c("healthy","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

linDA

# prepare the data
linda_data <- binomial_prep(ileum_genus_tab,
                            ileum_genus_taxa_tab,
                            ileum_metadata,
                            group, usage="linDA")

## Removing 53 ASV(s)

## Removing 5 ASV(s)

filt_ileum_uni_data <- linda_data[[1]]
filt_ileum_uni_taxa <- linda_data[[2]]
filt_ileum_uni_metadata <- linda_data[[3]]

# fit the model
linda.obj <- linda(filt_ileum_uni_data, 
                   filt_ileum_uni_metadata, 
                   formula = '~ Group')

## 0  features are filtered!
## The filtered data has  72  samples and  204  features will be tested!

## Warning in linda(filt_ileum_uni_data, filt_ileum_uni_metadata, formula = "~ Group"): Some features have less than 3 nonzero values! 
##                      They have virtually no statistical power. You may consider filtering them in the analysis!

## Pseudo-count approach is used.
## Fit linear models ...
## Completed.

linda.output <- linda.obj$output
linda.output <- linda_renaming(linda.output, group)

# save the results
group1 <- paste0(group[1], " vs ","Group",group[2])

for (grp in c(group1)){
  raw_linda_results_genus[[segment]][[grp]] <- 
    rawlinda.df(linda.output,
                grp,
                filt_ileum_uni_data,
                filt_ileum_uni_taxa)
  
  linda_results_genus[[segment]][[grp]] <- 
    linda.df(linda.output,
             grp,
             filt_ileum_uni_data,
             filt_ileum_uni_taxa)
}

# volcano plot
volcano_1 <- volcano_plot_linda(linda.output, 
                                group1, 
                                taxa_table = filt_ileum_uni_taxa) + 
            ggtitle(comparison_name)

volcano <- ggarrange(volcano_1)
volcano

MaAsLin2

volcano1 <- volcano_plot_maaslin(fit_data,filt_ileum_uni_taxa) + 
            ggtitle(comparison_name)

volcano <- ggarrange(volcano1)

## Warning: Removed 23 rows containing missing values or values outside the scale range (`geom_text_repel()`).

volcano

Group - Intersection

intersection_results <- group_intersection(group, list_intersections, list_venns,
                                           linda.output, fit_data,
                                           raw_linda_results_genus, 
                                           segment = segment,
                                           level=level)

list_intersections <- intersection_results[[1]]
list_venns <- intersection_results[[2]]
venn <- intersection_results[[3]]

# show the results
venn

Basic statistics

uni_df <-  merge(basic_univariate_statistics(linda_data,group),
                 raw_linda_results_genus[[segment]][[group1]],
                 by="SeqID",all=TRUE)

## [1] "healthy"
## [1] "post_ltx"
## [1] "healthy"
## [1] "post_ltx"

uni_df[["final_sig"]] <- uni_df$SeqID %in% list_intersections[[paste(segment,level,comparison_name)]][["SeqID"]]
uni_statistics[[segment]][[paste(level,comparison_name)]] <- uni_df

# for comparison
new_name <- comparison_name
addWorksheet(wb, sheetName = new_name)
writeData(wb, sheet = new_name, uni_df, rowNames=FALSE)

Visualization

Heatmap visualizing the linDA’s logFoldChange for taxa with p < 0.1.

list_heatmap <- list_intersections[grep(paste(segment,level),
                                  names(list_intersections),value=TRUE)]

p_heatmap_linda <- heatmap_linda(list_heatmap,ileum_taxa_tab)

## Warning: The melt generic in data.table has been passed a data.frame and will attempt to redirect to the
## relevant reshape2 method; please note that reshape2 is superseded and is no longer actively developed, and
## this redirection is now deprecated. To continue using melt methods from reshape2 while both libraries are
## attached, e.g. melt.list, you can prepend the namespace, i.e. reshape2::melt(plot_df). In the next version,
## this warning will become an error.
## Warning: The melt generic in data.table has been passed a data.frame and will attempt to redirect to the
## relevant reshape2 method; please note that reshape2 is superseded and is no longer actively developed, and
## this redirection is now deprecated. To continue using melt methods from reshape2 while both libraries are
## attached, e.g. melt.list, you can prepend the namespace, i.e. reshape2::melt(plot_df). In the next version,
## this warning will become an error.

## Warning: The dcast generic in data.table has been passed a data.frame and will attempt to redirect to the
## relevant reshape2 method; please note that reshape2 is superseded and is no longer actively developed, and
## this redirection is now deprecated. Please do this redirection yourself like
## reshape2::dcast(plot_df_combined). In the next version, this warning will become an error.

p_heatmap_linda

Dot heatmap

dotheatmap_linda <- dot_heatmap_linda(list_heatmap,
                                      uni_df,
                                      ileum_taxa_tab)

## Warning: The melt generic in data.table has been passed a data.frame and will attempt to redirect to the
## relevant reshape2 method; please note that reshape2 is superseded and is no longer actively developed, and
## this redirection is now deprecated. To continue using melt methods from reshape2 while both libraries are
## attached, e.g. melt.list, you can prepend the namespace, i.e. reshape2::melt(plot_df). In the next version,
## this warning will become an error.
## Warning: The melt generic in data.table has been passed a data.frame and will attempt to redirect to the
## relevant reshape2 method; please note that reshape2 is superseded and is no longer actively developed, and
## this redirection is now deprecated. To continue using melt methods from reshape2 while both libraries are
## attached, e.g. melt.list, you can prepend the namespace, i.e. reshape2::melt(plot_df). In the next version,
## this warning will become an error.
## Warning: The melt generic in data.table has been passed a data.frame and will attempt to redirect to the
## relevant reshape2 method; please note that reshape2 is superseded and is no longer actively developed, and
## this redirection is now deprecated. To continue using melt methods from reshape2 while both libraries are
## attached, e.g. melt.list, you can prepend the namespace, i.e. reshape2::melt(plot_df). In the next version,
## this warning will become an error.

## min_clr -1.689514 
## max_clr 5.277902 
## min_log -4.210103 
## max_log 2.80201

dotheatmap_linda

PSC effect

pre_LTx vs Healthy and Post_LTx vs Healthy intersection

imagename

A <- list_intersections[[paste(segment,level,"healthy vs pre_ltx")]]$SeqID
B <- list_intersections[[paste(segment,level,"healthy vs post_ltx")]]$SeqID
C <- intersect(A,B)

psc_effect[[paste(segment,level)]] <- list_intersections[[paste(segment,level, "healthy vs pre_ltx")]][list_intersections[[paste(segment,level, "healthy vs pre_ltx")]]$SeqID %in% C,]
  
# see the results
psc_effect[[paste(segment,level)]] 

Saving results

# ALL DATA
saveWorkbook(wb,file.path(path,paste0("uni_analysis_wb_",segment,".xlsx")),
             overwrite = TRUE)

# PSC effect
write.xlsx(psc_effect[[paste(segment,level)]],file.path(path,paste0("psc_effect_",segment,".xlsx")))

# SIGNIFICANT taxa

write.xlsx(list_intersections[grepl(segment,names(list_intersections))] %>%
            `names<-`(gsub(segment, "", names(
              list_intersections[grepl(segment,names(list_intersections))]))),
           file.path(path,paste0("significant_taxa_",segment,".xlsx")))

Supplementary Analysis

supplements_uni <- list()
supplements_wb <- createWorkbook()

ASV level

level="ASV"

path_maaslin="../intermediate_files/maaslin/Q1_norway/ASV/"

raw_linda_results <- list();
raw_linda_results[[segment]] <- list()
linda_results <- list(); 
linda_results[[segment]] <- list()

pre_ltx vs healthy

group <- c("healthy","pre_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

linDA

# prepare the data
linda_data <- binomial_prep(ileum_asv_tab,
                            ileum_taxa_tab,
                            ileum_metadata,
                            group, usage="linDA")

## Removing 532 ASV(s)

## Removing 83 ASV(s)

filt_ileum_uni_data <- linda_data[[1]]
filt_ileum_uni_taxa <- linda_data[[2]]
filt_ileum_uni_metadata <- linda_data[[3]]

# fit the model
linda.obj <- linda(filt_ileum_uni_data, 
                   filt_ileum_uni_metadata, 
                   formula = '~ Group')

## 0  features are filtered!
## The filtered data has  82  samples and  671  features will be tested!

## Warning in linda(filt_ileum_uni_data, filt_ileum_uni_metadata, formula = "~ Group"): Some features have less than 3 nonzero values! 
##                      They have virtually no statistical power. You may consider filtering them in the analysis!

## Pseudo-count approach is used.
## Fit linear models ...
## Completed.

linda.output <- linda.obj$output
linda.output <- linda_renaming(linda.output, group)

# save the results
group1 <- paste0(group[1], " vs ","Group",group[2])

for (grp in c(group1)){
  raw_linda_results[[segment]][[grp]] <- 
    rawlinda.df(linda.output,
                grp,
                filt_ileum_uni_data,
                filt_ileum_uni_taxa)
  
  linda_results[[segment]][[grp]] <- 
    linda.df(linda.output,
             grp,
             filt_ileum_uni_data,
             filt_ileum_uni_taxa)
}

# volcano plot
volcano_1 <- volcano_plot_linda(linda.output, 
                                group1, 
                                taxa_table = filt_ileum_uni_taxa) + 
            ggtitle(comparison_name)

volcano <- ggarrange(volcano_1, ncol=3)

MaAsLin2

volcano1 <- volcano_plot_maaslin(fit_data,filt_ileum_uni_taxa) + 
            ggtitle(comparison_name)

volcano <- ggarrange(volcano1, ncol=2)
volcano

## Warning: ggrepel: 24 unlabeled data points (too many overlaps). Consider increasing max.overlaps

Group - Intersection

intersection_results <- group_intersection(group, list_intersections, list_venns,
                                           linda.output, fit_data,
                                           raw_linda_results, 
                                           segment = segment,
                                           level=level)

list_intersections <- intersection_results[[1]]
list_venns <- intersection_results[[2]]
venn <- intersection_results[[3]]

# show the results
venn

Basic statistics

uni_df <-  merge(basic_univariate_statistics(linda_data,group),
                 raw_linda_results[[segment]][[group1]],
                 by="SeqID",all=TRUE)

## [1] "healthy"
## [1] "pre_ltx"
## [1] "healthy"
## [1] "pre_ltx"

uni_df[["final_sig"]] <- uni_df$SeqID %in% list_intersections[[paste(segment,level,comparison_name)]][["SeqID"]]
uni_statistics[[segment]][[paste(level,comparison_name)]] <- uni_df

# for comparison
new_name <- paste(level,comparison_name)
addWorksheet(supplements_wb, sheetName = new_name)
writeData(supplements_wb, sheet = new_name, uni_df, rowNames=FALSE)

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

linDA

# prepare the data
linda_data <- binomial_prep(ileum_asv_tab,
                            ileum_taxa_tab,
                            ileum_metadata,
                            group, usage="linDA")

## Removing 798 ASV(s)

## Removing 48 ASV(s)

filt_ileum_uni_data <- linda_data[[1]]
filt_ileum_uni_taxa <- linda_data[[2]]
filt_ileum_uni_metadata <- linda_data[[3]]

# fit the model
linda.obj <- linda(filt_ileum_uni_data, 
                   filt_ileum_uni_metadata, 
                   formula = '~ Group')

## 0  features are filtered!
## The filtered data has  82  samples and  536  features will be tested!

## Warning in linda(filt_ileum_uni_data, filt_ileum_uni_metadata, formula = "~ Group"): Some features have less than 3 nonzero values! 
##                      They have virtually no statistical power. You may consider filtering them in the analysis!

## Pseudo-count approach is used.
## Fit linear models ...
## Completed.

linda.output <- linda.obj$output
linda.output <- linda_renaming(linda.output, group)

# save the results
group1 <- paste0(group[1], " vs ","Group",group[2])

for (grp in c(group1)){
  raw_linda_results[[segment]][[grp]] <- 
    rawlinda.df(linda.output,
                grp,
                filt_ileum_uni_data,
                filt_ileum_uni_taxa)
  
  linda_results[[segment]][[grp]] <- 
    linda.df(linda.output,
             grp,
             filt_ileum_uni_data,
             filt_ileum_uni_taxa)
}

# volcano plot
volcano_1 <- volcano_plot_linda(linda.output, 
                                group1, 
                                taxa_table = filt_ileum_uni_taxa) + 
            ggtitle(comparison_name)

volcano <- ggarrange(volcano_1)

MaAsLin2

volcano1 <- volcano_plot_maaslin(fit_data,filt_ileum_uni_taxa) + 
            ggtitle(comparison_name)

volcano <- ggarrange(volcano1)
volcano

Group - Intersection

intersection_results <- group_intersection(group, list_intersections, list_venns,
                                           linda.output, fit_data,
                                           raw_linda_results, 
                                           segment = segment,
                                           level=level)

list_intersections <- intersection_results[[1]]
list_venns <- intersection_results[[2]]
venn <- intersection_results[[3]]

# show the results
venn

Basic statistics

uni_df <-  merge(basic_univariate_statistics(linda_data,group),
                 raw_linda_results[[segment]][[group1]],
                 by="SeqID",all=TRUE)

## [1] "pre_ltx"
## [1] "post_ltx"
## [1] "pre_ltx"
## [1] "post_ltx"

uni_df[["final_sig"]] <- uni_df$SeqID %in% list_intersections[[paste(segment,level,comparison_name)]][["SeqID"]]
uni_statistics[[segment]][[paste(level,comparison_name)]] <- uni_df

# for comparison
new_name <- paste(level,comparison_name)
addWorksheet(supplements_wb, sheetName = new_name)
writeData(supplements_wb, sheet = new_name, uni_df, rowNames=FALSE)

post_ltx vs healthy

group <- c("healthy","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

linDA

# prepare the data
linda_data <- binomial_prep(ileum_asv_tab,
                            ileum_taxa_tab,
                            ileum_metadata,
                            group, usage="linDA")

## Removing 582 ASV(s)

## Removing 94 ASV(s)

filt_ileum_uni_data <- linda_data[[1]]
filt_ileum_uni_taxa <- linda_data[[2]]
filt_ileum_uni_metadata <- linda_data[[3]]

# fit the model
linda.obj <- linda(filt_ileum_uni_data, 
                   filt_ileum_uni_metadata, 
                   formula = '~ Group')

## 0  features are filtered!
## The filtered data has  72  samples and  694  features will be tested!

## Warning in linda(filt_ileum_uni_data, filt_ileum_uni_metadata, formula = "~ Group"): Some features have less than 3 nonzero values! 
##                      They have virtually no statistical power. You may consider filtering them in the analysis!

## Pseudo-count approach is used.
## Fit linear models ...
## Completed.

linda.output <- linda.obj$output
linda.output <- linda_renaming(linda.output, group)

# save the results
group1 <- paste0(group[1], " vs ","Group",group[2])

for (grp in c(group1)){
  raw_linda_results[[segment]][[grp]] <- 
    rawlinda.df(linda.output,
                grp,
                filt_ileum_uni_data,
                filt_ileum_uni_taxa)
  
  linda_results[[segment]][[grp]] <- 
    linda.df(linda.output,
             grp,
             filt_ileum_uni_data,
             filt_ileum_uni_taxa)
}

# volcano plot
volcano_1 <- volcano_plot_linda(linda.output, 
                                group1, 
                                taxa_table = filt_ileum_uni_taxa) + 
            ggtitle(comparison_name)


volcano <- ggarrange(volcano_1)

MaAsLin2

volcano1 <- volcano_plot_maaslin(fit_data,filt_ileum_uni_taxa) + 
            ggtitle(comparison_name)


volcano <- ggarrange(volcano1)
volcano

Group - Intersection

intersection_results <- group_intersection(group, list_intersections, list_venns,
                                           linda.output, fit_data,
                                           raw_linda_results, 
                                           segment = segment,
                                           level=level)

list_intersections <- intersection_results[[1]]
list_venns <- intersection_results[[2]]
venn <- intersection_results[[3]]

# show the results
venn

Basic statistics

uni_df <-  merge(basic_univariate_statistics(linda_data,group),
                 raw_linda_results[[segment]][[group1]],
                 by="SeqID",all=TRUE)

## [1] "healthy"
## [1] "post_ltx"
## [1] "healthy"
## [1] "post_ltx"

uni_df[["final_sig"]] <- uni_df$SeqID %in% list_intersections[[paste(segment,level,comparison_name)]][["SeqID"]]
uni_statistics[[segment]][[paste(level,comparison_name)]] <- uni_df

# for comparison
new_name <- paste(level,comparison_name)
addWorksheet(supplements_wb, sheetName = new_name)
writeData(supplements_wb, sheet = new_name, uni_df, rowNames=FALSE)

Visualization

Heatmap visualizing the linDA’s logFoldChange for taxa with p < 0.1.

list_heatmap <- list_intersections[grep(paste(segment,level),
                                  names(list_intersections),value=TRUE)]

p_heatmap_linda <- heatmap_linda(list_heatmap,ileum_taxa_tab)

## Warning: The melt generic in data.table has been passed a data.frame and will attempt to redirect to the
## relevant reshape2 method; please note that reshape2 is superseded and is no longer actively developed, and
## this redirection is now deprecated. To continue using melt methods from reshape2 while both libraries are
## attached, e.g. melt.list, you can prepend the namespace, i.e. reshape2::melt(plot_df). In the next version,
## this warning will become an error.
## Warning: The melt generic in data.table has been passed a data.frame and will attempt to redirect to the
## relevant reshape2 method; please note that reshape2 is superseded and is no longer actively developed, and
## this redirection is now deprecated. To continue using melt methods from reshape2 while both libraries are
## attached, e.g. melt.list, you can prepend the namespace, i.e. reshape2::melt(plot_df). In the next version,
## this warning will become an error.

## Warning: The dcast generic in data.table has been passed a data.frame and will attempt to redirect to the
## relevant reshape2 method; please note that reshape2 is superseded and is no longer actively developed, and
## this redirection is now deprecated. Please do this redirection yourself like
## reshape2::dcast(plot_df_combined). In the next version, this warning will become an error.

p_heatmap_linda

Dot heatmap

dotheatmap_linda <- dot_heatmap_linda(list_heatmap,
                                      uni_df,
                                      ileum_taxa_tab)

## Warning: The melt generic in data.table has been passed a data.frame and will attempt to redirect to the
## relevant reshape2 method; please note that reshape2 is superseded and is no longer actively developed, and
## this redirection is now deprecated. To continue using melt methods from reshape2 while both libraries are
## attached, e.g. melt.list, you can prepend the namespace, i.e. reshape2::melt(plot_df). In the next version,
## this warning will become an error.
## Warning: The melt generic in data.table has been passed a data.frame and will attempt to redirect to the
## relevant reshape2 method; please note that reshape2 is superseded and is no longer actively developed, and
## this redirection is now deprecated. To continue using melt methods from reshape2 while both libraries are
## attached, e.g. melt.list, you can prepend the namespace, i.e. reshape2::melt(plot_df). In the next version,
## this warning will become an error.
## Warning: The melt generic in data.table has been passed a data.frame and will attempt to redirect to the
## relevant reshape2 method; please note that reshape2 is superseded and is no longer actively developed, and
## this redirection is now deprecated. To continue using melt methods from reshape2 while both libraries are
## attached, e.g. melt.list, you can prepend the namespace, i.e. reshape2::melt(plot_df). In the next version,
## this warning will become an error.

## min_clr -0.783254 
## max_clr 6.159805 
## min_log -4.599665 
## max_log 4.068987

dotheatmap_linda

PSC effect

pre_LTx vs Healthy and Post_LTx vs Healthy intersection

imagename

A <- list_intersections[[paste(segment,level,"healthy vs pre_ltx")]]$SeqID
B <- list_intersections[[paste(segment,level,"healthy vs post_ltx")]]$SeqID
C <- intersect(A,B)

psc_effect[[paste(segment,level)]] <- list_intersections[[paste(segment,level, "healthy vs pre_ltx")]][list_intersections[[paste(segment,level, "healthy vs pre_ltx")]]$SeqID %in% C,]
  
# see the results
psc_effect[[paste(segment,level)]] 

Phylum level

level="phylum"

path_maaslin="../intermediate_files/maaslin/Q1_norway/Phylum/"

raw_linda_results_phylum <- list();
raw_linda_results_phylum[[segment]] <- list()
linda_results_phylum <- list(); 
linda_results_phylum[[segment]] <- list()

Aggregate taxa

phylum_data <- aggregate_taxa(ileum_asv_tab,
                             ileum_taxa_tab,
                             taxonomic_level = "Phylum")

ileum_phylum_tab <- phylum_data[[1]]
ileum_phylum_taxa_tab <- phylum_data[[2]]

pre_ltx vs healthy

group <- c("healthy","pre_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

linDA

# prepare the data
linda_data <- binomial_prep(ileum_phylum_tab,
                            ileum_phylum_taxa_tab,
                            ileum_metadata,
                            group, usage="linDA")

filt_ileum_uni_data <- linda_data[[1]]
filt_ileum_uni_taxa <- linda_data[[2]]
filt_ileum_uni_metadata <- linda_data[[3]]

# fit the model
linda.obj <- linda(filt_ileum_uni_data, 
                   filt_ileum_uni_metadata, 
                   formula = '~ Group')

## 0  features are filtered!
## The filtered data has  82  samples and  10  features will be tested!
## Imputation approach is used.
## Fit linear models ...
## Completed.

linda.output <- linda.obj$output
linda.output <- linda_renaming(linda.output, group)

# save the results
group1 <- paste0(group[1], " vs ","Group",group[2])

for (grp in c(group1)){
  raw_linda_results_phylum[[segment]][[grp]] <- 
    rawlinda.df(linda.output,
                grp,
                filt_ileum_uni_data,
                filt_ileum_uni_taxa)
  
  linda_results_phylum[[segment]][[grp]] <- 
    linda.df(linda.output,
             grp,
             filt_ileum_uni_data,
             filt_ileum_uni_taxa)
}

# volcano plot
volcano_1 <- volcano_plot_linda(linda.output, 
                                group1, 
                                taxa_table = filt_ileum_uni_taxa) + 
            ggtitle(comparison_name)

## Using Phylum for naming

volcano <- ggarrange(volcano_1)

MaAsLin2

volcano1 <- volcano_plot_maaslin(fit_data,filt_ileum_uni_taxa) + 
            ggtitle(comparison_name)

volcano <- ggarrange(volcano1)
volcano

Group - Intersection

intersection_results <- group_intersection(group, list_intersections, list_venns,
                                           linda.output, fit_data,
                                           raw_linda_results_phylum, 
                                           segment = segment,
                                           level=level)

list_intersections <- intersection_results[[1]]
list_venns <- intersection_results[[2]]
venn <- intersection_results[[3]]

# show the results
venn

Basic statistics

uni_df <-  merge(basic_univariate_statistics(linda_data,group),
                 raw_linda_results_phylum[[segment]][[group1]],
                 by="SeqID",all=TRUE)

## [1] "healthy"
## [1] "pre_ltx"
## [1] "healthy"
## [1] "pre_ltx"

uni_df[["final_sig"]] <- uni_df$SeqID %in% list_intersections[[paste(segment,level,comparison_name)]][["SeqID"]]
uni_statistics[[segment]][[paste(level,comparison_name)]] <- uni_df

# for comparison
new_name <- paste(level,comparison_name)
addWorksheet(supplements_wb, sheetName = new_name)
writeData(supplements_wb, sheet = new_name, uni_df, rowNames=FALSE)

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

linDA

# prepare the data
linda_data <- binomial_prep(ileum_phylum_tab,
                            ileum_phylum_taxa_tab,
                            ileum_metadata,
                            group, usage="linDA")

## Removing 1 ASV(s)

filt_ileum_uni_data <- linda_data[[1]]
filt_ileum_uni_taxa <- linda_data[[2]]
filt_ileum_uni_metadata <- linda_data[[3]]

# fit the model
linda.obj <- linda(filt_ileum_uni_data, 
                   filt_ileum_uni_metadata, 
                   formula = '~ Group')

## 0  features are filtered!
## The filtered data has  82  samples and  11  features will be tested!
## Pseudo-count approach is used.
## Fit linear models ...
## Completed.

linda.output <- linda.obj$output
linda.output <- linda_renaming(linda.output, group)

# save the results
group1 <- paste0(group[1], " vs ","Group",group[2])

for (grp in c(group1)){
  raw_linda_results_phylum[[segment]][[grp]] <- 
    rawlinda.df(linda.output,
                grp,
                filt_ileum_uni_data,
                filt_ileum_uni_taxa)
  
  linda_results_phylum[[segment]][[grp]] <- 
    linda.df(linda.output,
             grp,
             filt_ileum_uni_data,
             filt_ileum_uni_taxa)
}

# volcano plot
volcano_1 <- volcano_plot_linda(linda.output, 
                                group1, 
                                taxa_table = filt_ileum_uni_taxa) + 
            ggtitle(comparison_name)

## Using Phylum for naming

volcano <- ggarrange(volcano_1)
volcano

MaAsLin2

volcano1 <- volcano_plot_maaslin(fit_data,filt_ileum_uni_taxa) + 
            ggtitle(comparison_name)

volcano <- ggarrange(volcano1)
volcano

Group - Intersection

intersection_results <- group_intersection(group, list_intersections, list_venns,
                                           linda.output, fit_data,
                                           raw_linda_results_phylum, 
                                           segment = segment,
                                           level=level)

list_intersections <- intersection_results[[1]]
list_venns <- intersection_results[[2]]
venn <- intersection_results[[3]]

# show the results
venn

Basic statistics

uni_df <-  merge(basic_univariate_statistics(linda_data,group),
                 raw_linda_results_phylum[[segment]][[group1]],
                 by="SeqID",all=TRUE)

## [1] "pre_ltx"
## [1] "post_ltx"
## [1] "pre_ltx"
## [1] "post_ltx"

uni_df[["final_sig"]] <- uni_df$SeqID %in% list_intersections[[paste(segment,level,comparison_name)]][["SeqID"]]
uni_statistics[[segment]][[paste(level,comparison_name)]] <- uni_df

# for comparison
new_name <- paste(level,comparison_name)
addWorksheet(supplements_wb, sheetName = new_name)
writeData(supplements_wb, sheet = new_name, uni_df, rowNames=FALSE)

post_ltx vs healthy

group <- c("healthy","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

linDA

# prepare the data
linda_data <- binomial_prep(ileum_phylum_tab,
                            ileum_phylum_taxa_tab,
                            ileum_metadata,
                            group, usage="linDA")

## Removing 2 ASV(s)

filt_ileum_uni_data <- linda_data[[1]]
filt_ileum_uni_taxa <- linda_data[[2]]
filt_ileum_uni_metadata <- linda_data[[3]]

# fit the model
linda.obj <- linda(filt_ileum_uni_data, 
                   filt_ileum_uni_metadata, 
                   formula = '~ Group')

## 0  features are filtered!
## The filtered data has  72  samples and  11  features will be tested!
## Pseudo-count approach is used.
## Fit linear models ...
## Completed.

linda.output <- linda.obj$output
linda.output <- linda_renaming(linda.output, group)

# save the results
group1 <- paste0(group[1], " vs ","Group",group[2])

for (grp in c(group1)){
  raw_linda_results_phylum[[segment]][[grp]] <- 
    rawlinda.df(linda.output,
                grp,
                filt_ileum_uni_data,
                filt_ileum_uni_taxa)
  
  linda_results_phylum[[segment]][[grp]] <- 
    linda.df(linda.output,
             grp,
             filt_ileum_uni_data,
             filt_ileum_uni_taxa)
}

# volcano plot
volcano_1 <- volcano_plot_linda(linda.output, 
                                group1, 
                                taxa_table = filt_ileum_uni_taxa) + 
            ggtitle(comparison_name)

## Using Phylum for naming

volcano <- ggarrange(volcano_1)
volcano

MaAsLin2

volcano1 <- volcano_plot_maaslin(fit_data,filt_ileum_uni_taxa) + 
            ggtitle(comparison_name)

volcano <- ggarrange(volcano1)
volcano

Group - Intersection

intersection_results <- group_intersection(group, list_intersections, list_venns,
                                           linda.output, fit_data,
                                           raw_linda_results_phylum, 
                                           segment = segment,
                                           level=level)

list_intersections <- intersection_results[[1]]
list_venns <- intersection_results[[2]]
venn <- intersection_results[[3]]

# show the results
venn

Basic statistics

uni_df <-  merge(basic_univariate_statistics(linda_data,group),
                 raw_linda_results_phylum[[segment]][[group1]],
                 by="SeqID",all=TRUE)

## [1] "healthy"
## [1] "post_ltx"
## [1] "healthy"
## [1] "post_ltx"

uni_df[["final_sig"]] <- uni_df$SeqID %in% list_intersections[[paste(segment,level,comparison_name)]][["SeqID"]]
uni_statistics[[segment]][[paste(level,comparison_name)]] <- uni_df

# for comparison
new_name <- paste(level,comparison_name)
addWorksheet(supplements_wb, sheetName = new_name)
writeData(supplements_wb, sheet = new_name, uni_df, rowNames=FALSE)

Visualization

Heatmap visualizing the linDA’s logFoldChange for taxa with p < 0.1.

list_heatmap <- list_intersections[grep(paste(segment,level),
                                  names(list_intersections),value=TRUE)]

p_heatmap_linda <- heatmap_linda(list_heatmap,ileum_taxa_tab)

## Warning: The melt generic in data.table has been passed a data.frame and will attempt to redirect to the
## relevant reshape2 method; please note that reshape2 is superseded and is no longer actively developed, and
## this redirection is now deprecated. To continue using melt methods from reshape2 while both libraries are
## attached, e.g. melt.list, you can prepend the namespace, i.e. reshape2::melt(plot_df). In the next version,
## this warning will become an error.
## Warning: The melt generic in data.table has been passed a data.frame and will attempt to redirect to the
## relevant reshape2 method; please note that reshape2 is superseded and is no longer actively developed, and
## this redirection is now deprecated. To continue using melt methods from reshape2 while both libraries are
## attached, e.g. melt.list, you can prepend the namespace, i.e. reshape2::melt(plot_df). In the next version,
## this warning will become an error.

## Warning: The dcast generic in data.table has been passed a data.frame and will attempt to redirect to the
## relevant reshape2 method; please note that reshape2 is superseded and is no longer actively developed, and
## this redirection is now deprecated. Please do this redirection yourself like
## reshape2::dcast(plot_df_combined). In the next version, this warning will become an error.

p_heatmap_linda

Dot heatmap

dotheatmap_linda <- dot_heatmap_linda(list_heatmap,
                                      uni_df,
                                      ileum_taxa_tab)

## Warning: The melt generic in data.table has been passed a data.frame and will attempt to redirect to the
## relevant reshape2 method; please note that reshape2 is superseded and is no longer actively developed, and
## this redirection is now deprecated. To continue using melt methods from reshape2 while both libraries are
## attached, e.g. melt.list, you can prepend the namespace, i.e. reshape2::melt(plot_df). In the next version,
## this warning will become an error.
## Warning: The melt generic in data.table has been passed a data.frame and will attempt to redirect to the
## relevant reshape2 method; please note that reshape2 is superseded and is no longer actively developed, and
## this redirection is now deprecated. To continue using melt methods from reshape2 while both libraries are
## attached, e.g. melt.list, you can prepend the namespace, i.e. reshape2::melt(plot_df). In the next version,
## this warning will become an error.
## Warning: The melt generic in data.table has been passed a data.frame and will attempt to redirect to the
## relevant reshape2 method; please note that reshape2 is superseded and is no longer actively developed, and
## this redirection is now deprecated. To continue using melt methods from reshape2 while both libraries are
## attached, e.g. melt.list, you can prepend the namespace, i.e. reshape2::melt(plot_df). In the next version,
## this warning will become an error.

## min_clr -3.06026 
## max_clr -0.1032386 
## min_log -3.531459 
## max_log -2.140763

dotheatmap_linda

PSC effect

pre_LTx vs Healthy and Post_LTx vs Healthy intersection

imagename

A <- list_intersections[[paste(segment,level,"healthy vs pre_ltx")]]$SeqID
B <- list_intersections[[paste(segment,level,"healthy vs post_ltx")]]$SeqID
C <- intersect(A,B)

psc_effect[[paste(segment,level)]] <- list_intersections[[paste(segment,level, "healthy vs pre_ltx")]][list_intersections[[paste(segment,level, "healthy vs pre_ltx")]]$SeqID %in% C,]
  
# see the results
psc_effect[[paste(segment,level)]] 

Saving results

# ALL DATA
saveWorkbook(supplements_wb,file.path(path,paste0("supplements_uni_analysis_wb_",segment,".xlsx")),overwrite = TRUE)

# PSC effect
write.xlsx(psc_effect,
          file.path(path,paste0("supplements_psc_effect_",segment,".xlsx")))

# SIGNIFICANT taxa
write.xlsx(list_intersections[grepl(segment,names(list_intersections))] %>%
            `names<-`(gsub(segment, "", names(
              list_intersections[grepl(segment,names(list_intersections))]))),
           file.path(path,paste0("supplements_significant_taxa_",segment,".xlsx")))

Machine learning

path = "../results/Q1_norway/models"

ElasticNet

model="enet"

ASV level

level="ASV"

pre_ltx vs healthy

group <- c("pre_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_asv_tab,
                                     ileum_taxa_tab,
                                     ileum_metadata,
                                     group, usage="ml_clr")

## Removing 532 ASV(s)

## Removing 83 ASV(s)

# fit the model
enet_model <- glmnet_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(enet_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
models_summ <- list()
models_cm <- list()
betas <- list()
roc_cs <- list()

models_summ[[model_name]] <- enet_model$model_summary
models_cm[[model_name]] <- enet_model$conf_matrices$original
roc_cs[[model_name]] <- enet_model$kfold_rocobjs
betas[[model_name]] <- as.matrix(enet_model$betas)

# see the results
enet_model$model_summary %>% t()

##                                       [,1]
## alpha                           0.20000000
## lambda                          0.07910989
## auc                             1.00000000
## auc_czech                              NaN
## auc_no                          1.00000000
## auc_optimism_corrected          0.93940116
## auc_optimism_corrected_CIL      0.90697421
## auc_optimism_corrected_CIU      0.96887255
## accuracy                        1.00000000
## accuracy_czech                         NaN
## accuracy_no                     1.00000000
## accuracy_optimism_corrected     0.85195830
## accuracy_optimism_corrected_CIL 0.77261494
## accuracy_optimism_corrected_CIU 0.91788462

enet_model$conf_matrices

## $original
##     Predicted
## True  0  1
##    0 36  0
##    1  0 46
## 
## $czech
## [1] NaN
## 
## $no
##     Predicted
## True  0  1
##    0 36  0
##    1  0 46

enet_model$plot

## `geom_smooth()` using formula = 'y ~ x'

## `geom_smooth()` using formula = 'y ~ x'

roc_c

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_asv_tab,
                                     ileum_taxa_tab,
                                     ileum_metadata,
                                     group, 
                                     usage="ml_clr")

## Removing 798 ASV(s)

## Removing 48 ASV(s)

# fit the model
enet_model <- glmnet_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC
roc_c <- roc_curve(enet_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
models_summ[[model_name]] <- enet_model$model_summary
models_cm[[model_name]] <- enet_model$conf_matrices$original
roc_cs[[model_name]] <- enet_model$kfold_rocobjs
betas[[model_name]] <- as.matrix(enet_model$betas)

# see the results
enet_model$model_summary %>% t()

##                                       [,1]
## alpha                           0.40000000
## lambda                          0.05275252
## auc                             1.00000000
## auc_czech                              NaN
## auc_no                          1.00000000
## auc_optimism_corrected          0.94864403
## auc_optimism_corrected_CIL      0.90596999
## auc_optimism_corrected_CIU      0.97906937
## accuracy                        1.00000000
## accuracy_czech                         NaN
## accuracy_no                     1.00000000
## accuracy_optimism_corrected     0.87262887
## accuracy_optimism_corrected_CIL 0.77354978
## accuracy_optimism_corrected_CIU 0.96640805

enet_model$conf_matrices

## $original
##     Predicted
## True  0  1
##    0 36  0
##    1  0 46
## 
## $czech
## [1] NaN
## 
## $no
##     Predicted
## True  0  1
##    0 36  0
##    1  0 46

enet_model$plot

## `geom_smooth()` using formula = 'y ~ x'

## `geom_smooth()` using formula = 'y ~ x'

roc_c

post_ltx vs healthy

group <- c("post_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_asv_tab,
                                     ileum_taxa_tab,
                                     ileum_metadata,
                                     group, 
                                     usage="ml_clr")

## Removing 582 ASV(s)

## Removing 94 ASV(s)

# fit the model
enet_model <- glmnet_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC
roc_c <- roc_curve(enet_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
models_summ[[model_name]] <- enet_model$model_summary
models_cm[[model_name]] <- enet_model$conf_matrices$original
roc_cs[[model_name]] <- enet_model$kfold_rocobjs
betas[[model_name]] <- as.matrix(enet_model$betas)

# see the results
enet_model$model_summary %>% t()

##                                       [,1]
## alpha                           0.20000000
## lambda                          0.04385149
## auc                             1.00000000
## auc_czech                              NaN
## auc_no                          1.00000000
## auc_optimism_corrected          0.94057858
## auc_optimism_corrected_CIL      0.79925426
## auc_optimism_corrected_CIU      1.00000000
## accuracy                        1.00000000
## accuracy_czech                         NaN
## accuracy_no                     1.00000000
## accuracy_optimism_corrected     0.86393284
## accuracy_optimism_corrected_CIL 0.75621693
## accuracy_optimism_corrected_CIU 0.95775000

enet_model$conf_matrices

## $original
##     Predicted
## True  0  1
##    0 36  0
##    1  0 36
## 
## $czech
## [1] NaN
## 
## $no
##     Predicted
## True  0  1
##    0 36  0
##    1  0 36

enet_model$plot

## `geom_smooth()` using formula = 'y ~ x'

## `geom_smooth()` using formula = 'y ~ x'

roc_c

Genus level

level="genus"

Aggregate taxa

genus_data <- aggregate_taxa(ileum_asv_tab,
                             ileum_taxa_tab,
                             taxonomic_level = level)

ileum_genus_tab <- genus_data[[1]]
ileum_genus_taxa_tab <- genus_data[[2]]

pre_ltx vs healthy

group <- c("pre_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_genus_tab,
                                     ileum_genus_taxa_tab,
                                     ileum_metadata,
                                     group, 
                                     usage="ml_clr")

## Removing 37 ASV(s)

## Removing 6 ASV(s)

# fit the model
enet_model <- glmnet_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC
roc_c <- roc_curve(enet_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
models_summ[[model_name]] <- enet_model$model_summary
models_cm[[model_name]] <- enet_model$conf_matrices$original
roc_cs[[model_name]] <- enet_model$kfold_rocobjs
betas[[model_name]] <- as.matrix(enet_model$betas)

# see the results
enet_model$model_summary %>% t()

##                                       [,1]
## alpha                           0.40000000
## lambda                          0.01643358
## auc                             1.00000000
## auc_czech                              NaN
## auc_no                          1.00000000
## auc_optimism_corrected          0.94540077
## auc_optimism_corrected_CIL      0.86825397
## auc_optimism_corrected_CIU      0.99368476
## accuracy                        1.00000000
## accuracy_czech                         NaN
## accuracy_no                     1.00000000
## accuracy_optimism_corrected     0.85396968
## accuracy_optimism_corrected_CIL 0.73884615
## accuracy_optimism_corrected_CIU 0.96479167

enet_model$conf_matrices

## $original
##     Predicted
## True  0  1
##    0 36  0
##    1  0 46
## 
## $czech
## [1] NaN
## 
## $no
##     Predicted
## True  0  1
##    0 36  0
##    1  0 46

enet_model$plot

## `geom_smooth()` using formula = 'y ~ x'

## `geom_smooth()` using formula = 'y ~ x'

roc_c

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_genus_tab,
                                     ileum_genus_taxa_tab,
                                     ileum_metadata,
                                     group, 
                                     usage="ml_clr")

## Removing 30 ASV(s)

## Removing 5 ASV(s)

# fit the model
enet_model <- glmnet_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC
roc_c <- roc_curve(enet_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
models_summ[[model_name]] <- enet_model$model_summary
models_cm[[model_name]] <- enet_model$conf_matrices$original
roc_cs[[model_name]] <- enet_model$kfold_rocobjs
betas[[model_name]] <- as.matrix(enet_model$betas)

# see the results
enet_model$model_summary %>% t()

##                                       [,1]
## alpha                           1.00000000
## lambda                          0.04853802
## auc                             0.99879227
## auc_czech                              NaN
## auc_no                          0.99879227
## auc_optimism_corrected          0.96852373
## auc_optimism_corrected_CIL      0.90471524
## auc_optimism_corrected_CIU      1.00000000
## accuracy                        0.95121951
## accuracy_czech                         NaN
## accuracy_no                     0.95121951
## accuracy_optimism_corrected     0.89068802
## accuracy_optimism_corrected_CIL 0.81005245
## accuracy_optimism_corrected_CIU 0.95270833

enet_model$conf_matrices

## $original
##     Predicted
## True  0  1
##    0 36  0
##    1  4 42
## 
## $czech
## [1] NaN
## 
## $no
##     Predicted
## True  0  1
##    0 36  0
##    1  4 42

enet_model$plot

## `geom_smooth()` using formula = 'y ~ x'

## `geom_smooth()` using formula = 'y ~ x'

roc_c

post_ltx vs healthy

group <- c("post_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_genus_tab,
                                     ileum_genus_taxa_tab,
                                     ileum_metadata,group, 
                                     usage="ml_clr")

## Removing 53 ASV(s)

## Removing 5 ASV(s)

# fit the model
enet_model <- glmnet_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC
roc_c <- roc_curve(enet_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
models_summ[[model_name]] <- enet_model$model_summary
models_cm[[model_name]] <- enet_model$conf_matrices$original
roc_cs[[model_name]] <- enet_model$kfold_rocobjs
betas[[model_name]] <- as.matrix(enet_model$betas)

# see the results
enet_model$model_summary %>% t()

##                                      [,1]
## alpha                           0.2000000
## lambda                          0.1915607
## auc                             1.0000000
## auc_czech                             NaN
## auc_no                          1.0000000
## auc_optimism_corrected          0.9177772
## auc_optimism_corrected_CIL      0.7889323
## auc_optimism_corrected_CIU      0.9922890
## accuracy                        1.0000000
## accuracy_czech                        NaN
## accuracy_no                     1.0000000
## accuracy_optimism_corrected     0.8372821
## accuracy_optimism_corrected_CIL 0.6505357
## accuracy_optimism_corrected_CIU 0.9577500

enet_model$conf_matrices

## $original
##     Predicted
## True  0  1
##    0 36  0
##    1  0 36
## 
## $czech
## [1] NaN
## 
## $no
##     Predicted
## True  0  1
##    0 36  0
##    1  0 36

enet_model$plot

## `geom_smooth()` using formula = 'y ~ x'

## `geom_smooth()` using formula = 'y ~ x'

roc_c

Saving results

models_summ_df_ileum <- do.call(rbind, 
  models_summ[grep(segment,names(models_summ),value = TRUE)])

write.csv(models_summ_df_ileum,file.path(path,paste0("elastic_net_",segment,".csv")))

Supplementary models

supplements_models <- list()

CLR-transformed data

kNN

model="knn"

ASV level

level="ASV"

pre_ltx vs healthy

group <- c("pre_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_asv_tab,
                                     ileum_taxa_tab,
                                     ileum_metadata,
                                     group, usage="ml_clr")

## Removing 532 ASV(s)

## Removing 83 ASV(s)

# fit the model
knn_model <- knn_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(knn_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["knn_model"]][[model_name]] <- knn_model$model_summary
supplements_models[["roc_cs"]][["knn_model"]][[model_name]] <- knn_model$kfold_rocobjs

# see the results
knn_model$model_summary %>% t()

##                                       [,1]
## k                               15.0000000
## auc                              0.9471618
## auc_optimism_corrected           0.8688287
## auc_optimism_corrected_CIL       0.7812429
## auc_optimism_corrected_CIU       0.9217320
## accuracy                         0.8902439
## accuracy_optimism_corrected      0.7729655
## accuracy_optimism_corrected_CIL  0.6567308
## accuracy_optimism_corrected_CIU  0.8432692

roc_c

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)


# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_asv_tab,
                                     ileum_taxa_tab,
                                     ileum_metadata,
                                     group, usage="ml_clr")

## Removing 798 ASV(s)

## Removing 48 ASV(s)

# fit the model
knn_model <- knn_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(knn_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["knn_model"]][[model_name]] <- knn_model$model_summary
supplements_models[["roc_cs"]][["knn_model"]][[model_name]] <- knn_model$kfold_rocobjs


# see the results
knn_model$model_summary %>% t()

##                                       [,1]
## k                               29.0000000
## auc                              0.8916063
## auc_optimism_corrected           0.7733049
## auc_optimism_corrected_CIL       0.6753055
## auc_optimism_corrected_CIU       0.8794286
## accuracy                         0.8170732
## accuracy_optimism_corrected      0.6834489
## accuracy_optimism_corrected_CIL  0.5821154
## accuracy_optimism_corrected_CIU  0.7629167

roc_c

post_ltx vs healthy

group <- c("post_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_asv_tab,
                                     ileum_taxa_tab,
                                     ileum_metadata,
                                     group, usage="ml_clr")

## Removing 582 ASV(s)

## Removing 94 ASV(s)

# fit the model
knn_model <- knn_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(knn_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
# save the results
supplements_models[["models_summ"]][["knn_model"]][[model_name]] <- knn_model$model_summary
supplements_models[["roc_cs"]][["knn_model"]][[model_name]] <- knn_model$kfold_rocobjs

# see the results
knn_model$model_summary %>% t()

##                                       [,1]
## k                               23.0000000
## auc                              0.9390432
## auc_optimism_corrected           0.8979242
## auc_optimism_corrected_CIL       0.7785511
## auc_optimism_corrected_CIU       0.9974888
## accuracy                         0.8750000
## accuracy_optimism_corrected      0.7897957
## accuracy_optimism_corrected_CIL  0.6150000
## accuracy_optimism_corrected_CIU  0.9387500

roc_c

Genus level

level="genus"

Aggregate taxa

genus_data <- aggregate_taxa(ileum_asv_tab,
                             ileum_taxa_tab,
                             taxonomic_level = level)

ileum_genus_tab <- genus_data[[1]]
ileum_genus_taxa_tab <- genus_data[[2]]

pre_ltx vs healthy

group <- c("pre_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_genus_tab,
                                     ileum_genus_taxa_tab,
                                     ileum_metadata,
                                     group, 
                                     usage="ml_clr")

## Removing 37 ASV(s)

## Removing 6 ASV(s)

# fit the model
knn_model <- knn_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(knn_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["knn_model"]][[model_name]] <- knn_model$model_summary
supplements_models[["roc_cs"]][["knn_model"]][[model_name]] <- knn_model$kfold_rocobjs


# see the results
knn_model$model_summary %>% t()

##                                       [,1]
## k                               29.0000000
## auc                              0.9465580
## auc_optimism_corrected           0.8917541
## auc_optimism_corrected_CIL       0.7452390
## auc_optimism_corrected_CIU       0.9640501
## accuracy                         0.7926829
## accuracy_optimism_corrected      0.7719603
## accuracy_optimism_corrected_CIL  0.6541446
## accuracy_optimism_corrected_CIU  0.9035714

roc_c

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_genus_tab,
                                     ileum_genus_taxa_tab,
                                     ileum_metadata,
                                     group, 
                                     usage="ml_clr")

## Removing 30 ASV(s)

## Removing 5 ASV(s)

# fit the model
knn_model <- knn_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(knn_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["knn_model"]][[model_name]] <- knn_model$model_summary
supplements_models[["roc_cs"]][["knn_model"]][[model_name]] <- knn_model$kfold_rocobjs


# see the results
knn_model$model_summary %>% t()

##                                       [,1]
## k                               22.0000000
## auc                              0.8786232
## auc_optimism_corrected           0.7599639
## auc_optimism_corrected_CIL       0.6547210
## auc_optimism_corrected_CIU       0.9204762
## accuracy                         0.7804878
## accuracy_optimism_corrected      0.6637893
## accuracy_optimism_corrected_CIL  0.5812121
## accuracy_optimism_corrected_CIU  0.7903846

roc_c

post_ltx vs healthy

group <- c("post_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_genus_tab,
                                     ileum_genus_taxa_tab,
                                     ileum_metadata,
                                     group, 
                                     usage="ml_clr")

## Removing 53 ASV(s)

## Removing 5 ASV(s)

# fit the model
knn_model <- knn_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(knn_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["knn_model"]][[model_name]] <- knn_model$model_summary
supplements_models[["roc_cs"]][["knn_model"]][[model_name]] <- knn_model$kfold_rocobjs


# see the results
knn_model$model_summary %>% t()

##                                       [,1]
## k                               10.0000000
## auc                              0.9614198
## auc_optimism_corrected           0.9134301
## auc_optimism_corrected_CIL       0.8567854
## auc_optimism_corrected_CIU       0.9878517
## accuracy                         0.8194444
## accuracy_optimism_corrected      0.7624438
## accuracy_optimism_corrected_CIL  0.6096429
## accuracy_optimism_corrected_CIU  0.9352500

roc_c

Random Forest

model="rf"

ASV level

level="ASV"

pre_ltx vs healthy

group <- c("pre_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_asv_tab,
                                     ileum_taxa_tab,
                                     ileum_metadata,
                                     group, usage="ml_clr")

## Removing 532 ASV(s)

## Removing 83 ASV(s)

# fit the model
rf_model <- rf_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(rf_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["rf_model"]][[model_name]] <- rf_model$model_summary
supplements_models[["roc_cs"]][["rf_model"]][[model_name]] <- rf_model$kfold_rocobjs

# see the results
rf_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "131"      
## splitrule                       "gini"     
## min.node.size                   "2"        
## auc                             "1"        
## auc_optimism_corrected          "0.9460283"
## auc_optimism_corrected_CIL      "0.8288603"
## auc_optimism_corrected_CIU      "0.9936959"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.8566836"
## accuracy_optimism_corrected_CIL "0.7280594"
## accuracy_optimism_corrected_CIU "0.9608173"

roc_c

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_asv_tab,
                                     ileum_taxa_tab,
                                     ileum_metadata,
                                     group, usage="ml_clr")

## Removing 798 ASV(s)

## Removing 48 ASV(s)

# fit the model
rf_model <- rf_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(rf_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["rf_model"]][[model_name]] <- rf_model$model_summary
supplements_models[["roc_cs"]][["rf_model"]][[model_name]] <- rf_model$kfold_rocobjs

# see the results
rf_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "145"      
## splitrule                       "gini"     
## min.node.size                   "5"        
## auc                             "1"        
## auc_optimism_corrected          "0.9413764"
## auc_optimism_corrected_CIL      "0.8901268"
## auc_optimism_corrected_CIU      "0.990127" 
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.9077304"
## accuracy_optimism_corrected_CIL "0.8076923"
## accuracy_optimism_corrected_CIU "0.9655128"

roc_c

post_ltx vs healthy

group <- c("post_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_asv_tab,
                                     ileum_taxa_tab,
                                     ileum_metadata,
                                     group, usage="ml_clr")

## Removing 582 ASV(s)

## Removing 94 ASV(s)

# fit the model
rf_model <- rf_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(rf_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["rf_model"]][[model_name]] <- rf_model$model_summary
supplements_models[["roc_cs"]][["rf_model"]][[model_name]] <- rf_model$kfold_rocobjs

# see the results
rf_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "483"      
## splitrule                       "gini"     
## min.node.size                   "2"        
## auc                             "1"        
## auc_optimism_corrected          "0.9255632"
## auc_optimism_corrected_CIL      "0.8548363"
## auc_optimism_corrected_CIU      "1"        
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.7760814"
## accuracy_optimism_corrected_CIL "0.5868571"
## accuracy_optimism_corrected_CIU "0.913"

roc_c

Genus level

level="genus"

Aggregate taxa

genus_data <- aggregate_taxa(ileum_asv_tab,
                             ileum_taxa_tab,
                             taxonomic_level = level)

ileum_genus_tab <- genus_data[[1]]
ileum_genus_taxa_tab <- genus_data[[2]]

pre_ltx vs healthy

group <- c("pre_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_genus_tab,
                                     ileum_genus_taxa_tab,
                                     ileum_metadata,
                                     group, 
                                     usage="ml_clr")

## Removing 37 ASV(s)

## Removing 6 ASV(s)

# fit the model
rf_model <- rf_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(rf_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["rf_model"]][[model_name]] <- rf_model$model_summary
supplements_models[["roc_cs"]][["rf_model"]][[model_name]] <- rf_model$kfold_rocobjs

# see the results
rf_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "53"       
## splitrule                       "gini"     
## min.node.size                   "5"        
## auc                             "1"        
## auc_optimism_corrected          "0.957942" 
## auc_optimism_corrected_CIL      "0.8537879"
## auc_optimism_corrected_CIU      "0.9953091"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.8762018"
## accuracy_optimism_corrected_CIL "0.7802448"
## accuracy_optimism_corrected_CIU "0.9582759"

roc_c

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_genus_tab,
                                     ileum_genus_taxa_tab,
                                     ileum_metadata,
                                     group, 
                                     usage="ml_clr")

## Removing 30 ASV(s)

## Removing 5 ASV(s)

# fit the model
rf_model <- rf_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(rf_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["rf_model"]][[model_name]] <- rf_model$model_summary
supplements_models[["roc_cs"]][["rf_model"]][[model_name]] <- rf_model$kfold_rocobjs

# see the results
rf_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "49"       
## splitrule                       "gini"     
## min.node.size                   "2"        
## auc                             "1"        
## auc_optimism_corrected          "0.9296244"
## auc_optimism_corrected_CIL      "0.9000255"
## auc_optimism_corrected_CIU      "0.956032" 
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.8686224"
## accuracy_optimism_corrected_CIL "0.7741379"
## accuracy_optimism_corrected_CIU "0.9380303"

roc_c

post_ltx vs healthy

group <- c("post_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_genus_tab,
                                     ileum_genus_taxa_tab,
                                     ileum_metadata,
                                     group, 
                                     usage="ml_clr")

## Removing 53 ASV(s)

## Removing 5 ASV(s)

# fit the model
rf_model <- rf_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(rf_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["rf_model"]][[model_name]] <- rf_model$model_summary
supplements_models[["roc_cs"]][["rf_model"]][[model_name]] <- rf_model$kfold_rocobjs

# see the results
rf_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "191"      
## splitrule                       "gini"     
## min.node.size                   "2"        
## auc                             "1"        
## auc_optimism_corrected          "0.9271352"
## auc_optimism_corrected_CIL      "0.8579427"
## auc_optimism_corrected_CIU      "0.9946429"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.8212688"
## accuracy_optimism_corrected_CIL "0.7142857"
## accuracy_optimism_corrected_CIU "0.939"

roc_c

Gradient boosting

model="gb"

ASV level

level="ASV"

pre_ltx vs healthy

group <- c("pre_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_asv_tab,
                                     ileum_taxa_tab,
                                     ileum_metadata,
                                     group, usage="ml_clr")

## Removing 532 ASV(s)

## Removing 83 ASV(s)

# fit the model
gbm_model <- gbm_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(gbm_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["gbm_model"]][[model_name]] <- gbm_model$model_summary
supplements_models[["roc_cs"]][["gbm_model"]][[model_name]] <- gbm_model$kfold_rocobjs

# see the results
gbm_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "191"      
## splitrule                       "gini"     
## min.node.size                   "2"        
## auc                             "1"        
## auc_optimism_corrected          "0.9271352"
## auc_optimism_corrected_CIL      "0.8579427"
## auc_optimism_corrected_CIU      "0.9946429"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.8212688"
## accuracy_optimism_corrected_CIL "0.7142857"
## accuracy_optimism_corrected_CIU "0.939"

roc_c

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_asv_tab,
                                     ileum_taxa_tab,
                                     ileum_metadata,
                                     group, usage="ml_clr")

## Removing 798 ASV(s)

## Removing 48 ASV(s)

# fit the model
gbm_model <- gbm_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(gbm_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["gbm_model"]][[model_name]] <- gbm_model$model_summary
supplements_models[["roc_cs"]][["gbm_model"]][[model_name]] <- gbm_model$kfold_rocobjs


# see the results
gbm_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "191"      
## splitrule                       "gini"     
## min.node.size                   "2"        
## auc                             "1"        
## auc_optimism_corrected          "0.9271352"
## auc_optimism_corrected_CIL      "0.8579427"
## auc_optimism_corrected_CIU      "0.9946429"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.8212688"
## accuracy_optimism_corrected_CIL "0.7142857"
## accuracy_optimism_corrected_CIU "0.939"

roc_c

post_ltx vs healthy

group <- c("post_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_asv_tab,
                                     ileum_taxa_tab,
                                     ileum_metadata,
                                     group, usage="ml_clr")

## Removing 582 ASV(s)

## Removing 94 ASV(s)

# fit the model
gbm_model <- gbm_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(gbm_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["gbm_model"]][[model_name]] <- gbm_model$model_summary
supplements_models[["roc_cs"]][["gbm_model"]][[model_name]] <- gbm_model$kfold_rocobjs


# see the results
gbm_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "191"      
## splitrule                       "gini"     
## min.node.size                   "2"        
## auc                             "1"        
## auc_optimism_corrected          "0.9271352"
## auc_optimism_corrected_CIL      "0.8579427"
## auc_optimism_corrected_CIU      "0.9946429"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.8212688"
## accuracy_optimism_corrected_CIL "0.7142857"
## accuracy_optimism_corrected_CIU "0.939"

roc_c

Genus level

level="genus"

Aggregate taxa

genus_data <- aggregate_taxa(ileum_asv_tab,
                             ileum_taxa_tab,
                             taxonomic_level = level)

ileum_genus_tab <- genus_data[[1]]
ileum_genus_taxa_tab <- genus_data[[2]]

pre_ltx vs healthy

group <- c("pre_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_genus_tab,
                                     ileum_genus_taxa_tab,
                                     ileum_metadata,
                                     group, 
                                     usage="ml_clr")

## Removing 37 ASV(s)

## Removing 6 ASV(s)

# fit the model
gbm_model <- gbm_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(gbm_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["gbm_model"]][[model_name]] <- gbm_model$model_summary
supplements_models[["roc_cs"]][["gbm_model"]][[model_name]] <- gbm_model$kfold_rocobjs

# see the results
gbm_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "191"      
## splitrule                       "gini"     
## min.node.size                   "2"        
## auc                             "1"        
## auc_optimism_corrected          "0.9271352"
## auc_optimism_corrected_CIL      "0.8579427"
## auc_optimism_corrected_CIU      "0.9946429"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.8212688"
## accuracy_optimism_corrected_CIL "0.7142857"
## accuracy_optimism_corrected_CIU "0.939"

roc_c

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_genus_tab,
                                     ileum_genus_taxa_tab,
                                     ileum_metadata,
                                     group, 
                                     usage="ml_clr")

## Removing 30 ASV(s)

## Removing 5 ASV(s)

# fit the model
gbm_model <- gbm_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(gbm_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["gbm_model"]][[model_name]] <- gbm_model$model_summary
supplements_models[["roc_cs"]][["gbm_model"]][[model_name]] <- gbm_model$kfold_rocobjs

# see the results
gbm_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "191"      
## splitrule                       "gini"     
## min.node.size                   "2"        
## auc                             "1"        
## auc_optimism_corrected          "0.9271352"
## auc_optimism_corrected_CIL      "0.8579427"
## auc_optimism_corrected_CIU      "0.9946429"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.8212688"
## accuracy_optimism_corrected_CIL "0.7142857"
## accuracy_optimism_corrected_CIU "0.939"

roc_c

post_ltx vs healthy

group <- c("post_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_genus_tab,
                                     ileum_genus_taxa_tab,
                                     ileum_metadata,
                                     group, 
                                     usage="ml_clr")

## Removing 53 ASV(s)

## Removing 5 ASV(s)

# fit the model
gbm_model <- gbm_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(gbm_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["gbm_model"]][[model_name]] <- gbm_model$model_summary
supplements_models[["roc_cs"]][["gbm_model"]][[model_name]] <- gbm_model$kfold_rocobjs

# see the results
gbm_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "191"      
## splitrule                       "gini"     
## min.node.size                   "2"        
## auc                             "1"        
## auc_optimism_corrected          "0.9271352"
## auc_optimism_corrected_CIL      "0.8579427"
## auc_optimism_corrected_CIU      "0.9946429"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.8212688"
## accuracy_optimism_corrected_CIL "0.7142857"
## accuracy_optimism_corrected_CIU "0.939"

roc_c

Relative abundances

Elastic net

ASV level

level="ASV"

pre_ltx vs healthy

group <- c("pre_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_asv_tab,
                                     ileum_taxa_tab,
                                     ileum_metadata,
                                     group, usage="ml_ra")

## Removing 532 ASV(s)

## Removing 83 ASV(s)

# fit the model
enet_model <- glmnet_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(enet_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["enet_model_ra"]][[model_name]] <- enet_model$model_summary

supplements_models[["roc_cs"]][["enet_model_ra"]][[model_name]] <- enet_model$kfold_rocobjs

# see the results
enet_model$model_summary %>% t()

##                                      [,1]
## alpha                           1.0000000
## lambda                          0.0754005
## auc                             1.0000000
## auc_czech                             NaN
## auc_no                          1.0000000
## auc_optimism_corrected          0.8844558
## auc_optimism_corrected_CIL      0.7700893
## auc_optimism_corrected_CIU      0.9701827
## accuracy                        0.9512195
## accuracy_czech                        NaN
## accuracy_no                     0.9512195
## accuracy_optimism_corrected     0.8028923
## accuracy_optimism_corrected_CIL 0.6619032
## accuracy_optimism_corrected_CIU 0.9250575

roc_c

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_asv_tab,
                                     ileum_taxa_tab,
                                     ileum_metadata,
                                     group, usage="ml_ra")

## Removing 798 ASV(s)

## Removing 48 ASV(s)

# fit the model
enet_model <- glmnet_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(enet_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["enet_model_ra"]][[model_name]] <- enet_model$model_summary

supplements_models[["roc_cs"]][["enet_model_ra"]][[model_name]] <- enet_model$kfold_rocobjs

# see the results
enet_model$model_summary %>% t()

##                                       [,1]
## alpha                           1.00000000
## lambda                          0.09697496
## auc                             0.93417874
## auc_czech                              NaN
## auc_no                          0.93417874
## auc_optimism_corrected          0.77458515
## auc_optimism_corrected_CIL      0.56854887
## auc_optimism_corrected_CIU      0.89133955
## accuracy                        0.85365854
## accuracy_czech                         NaN
## accuracy_no                     0.85365854
## accuracy_optimism_corrected     0.70244307
## accuracy_optimism_corrected_CIL 0.65414456
## accuracy_optimism_corrected_CIU 0.77035714

roc_c

post_ltx vs healthy

group <- c("post_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)


# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_asv_tab,
                                     ileum_taxa_tab,
                                     ileum_metadata,
                                     group, usage="ml_ra")

## Removing 582 ASV(s)

## Removing 94 ASV(s)

# fit the model
enet_model <- glmnet_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(enet_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["enet_model_ra"]][[model_name]] <- enet_model$model_summary

supplements_models[["roc_cs"]][["enet_model_ra"]][[model_name]] <- enet_model$kfold_rocobjs

# see the results
enet_model$model_summary %>% t()

##                                      [,1]
## alpha                           0.2000000
## lambda                          0.2020060
## auc                             1.0000000
## auc_czech                             NaN
## auc_no                          1.0000000
## auc_optimism_corrected          0.8785422
## auc_optimism_corrected_CIL      0.7718256
## auc_optimism_corrected_CIU      0.9946429
## accuracy                        1.0000000
## accuracy_czech                        NaN
## accuracy_no                     1.0000000
## accuracy_optimism_corrected     0.8029910
## accuracy_optimism_corrected_CIL 0.6379630
## accuracy_optimism_corrected_CIU 0.9155000

roc_c

Genus level

level="genus"

Aggregate taxa

genus_data <- aggregate_taxa(ileum_asv_tab,
                             ileum_taxa_tab,
                             taxonomic_level = level)

ileum_genus_tab <- genus_data[[1]]
ileum_genus_taxa_tab <- genus_data[[2]]

pre_ltx vs healthy

group <- c("pre_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_genus_tab,
                                     ileum_genus_taxa_tab,
                                     ileum_metadata,
                                     group, 
                                     usage="ml_ra")

## Removing 37 ASV(s)

## Removing 6 ASV(s)

# fit the model
enet_model <- glmnet_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(enet_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["enet_model_ra"]][[model_name]] <- enet_model$model_summary

supplements_models[["roc_cs"]][["enet_model_ra"]][[model_name]] <- enet_model$kfold_rocobjs

# see the results
enet_model$model_summary %>% t()

##                                       [,1]
## alpha                           0.40000000
## lambda                          0.06226444
## auc                             1.00000000
## auc_czech                              NaN
## auc_no                          1.00000000
## auc_optimism_corrected          0.90118822
## auc_optimism_corrected_CIL      0.81208129
## auc_optimism_corrected_CIU      0.99035714
## accuracy                        1.00000000
## accuracy_czech                         NaN
## accuracy_no                     1.00000000
## accuracy_optimism_corrected     0.83700920
## accuracy_optimism_corrected_CIL 0.73613636
## accuracy_optimism_corrected_CIU 0.97672414

roc_c

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)


# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_genus_tab,
                                     ileum_genus_taxa_tab,
                                     ileum_metadata,
                                     group, 
                                     usage="ml_ra")

## Removing 30 ASV(s)

## Removing 5 ASV(s)

# fit the model
enet_model <- glmnet_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(enet_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["enet_model_ra"]][[model_name]] <- enet_model$model_summary

supplements_models[["roc_cs"]][["enet_model_ra"]][[model_name]] <- enet_model$kfold_rocobjs

# see the results
enet_model$model_summary %>% t()

##                                      [,1]
## alpha                           0.8000000
## lambda                          0.1018225
## auc                             0.9516908
## auc_czech                             NaN
## auc_no                          0.9516908
## auc_optimism_corrected          0.6471438
## auc_optimism_corrected_CIL      0.4931213
## auc_optimism_corrected_CIU      0.8361818
## accuracy                        0.8414634
## accuracy_czech                        NaN
## accuracy_no                     0.8414634
## accuracy_optimism_corrected     0.6077638
## accuracy_optimism_corrected_CIL 0.4663130
## accuracy_optimism_corrected_CIU 0.7984615

roc_c

post_ltx vs healthy

group <- c("post_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_genus_tab,
                                     ileum_genus_taxa_tab,
                                     ileum_metadata,
                                     group, 
                                     usage="ml_ra")

## Removing 53 ASV(s)

## Removing 5 ASV(s)

# fit the model
enet_model <- glmnet_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(enet_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["enet_model_ra"]][[model_name]] <- enet_model$model_summary

supplements_models[["roc_cs"]][["enet_model_ra"]][[model_name]] <- enet_model$kfold_rocobjs

# see the results
enet_model$model_summary %>% t()

##                                      [,1]
## alpha                           0.2000000
## lambda                          0.1405792
## auc                             1.0000000
## auc_czech                             NaN
## auc_no                          1.0000000
## auc_optimism_corrected          0.9000606
## auc_optimism_corrected_CIL      0.8088914
## auc_optimism_corrected_CIU      0.9858360
## accuracy                        1.0000000
## accuracy_czech                        NaN
## accuracy_no                     1.0000000
## accuracy_optimism_corrected     0.8242481
## accuracy_optimism_corrected_CIL 0.6877143
## accuracy_optimism_corrected_CIU 0.9130000

roc_c

kNN

ASV level

level="ASV"

pre_ltx vs healthy

group <- c("pre_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_asv_tab,
                                     ileum_taxa_tab,
                                     ileum_metadata,
                                     group, usage="ml_ra")

## Removing 532 ASV(s)

## Removing 83 ASV(s)

# fit the model
knn_model <- knn_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(knn_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["knn_model_ra"]][[model_name]] <- knn_model$model_summary

supplements_models[["roc_cs"]][["knn_model_ra"]][[model_name]] <- knn_model$kfold_rocobjs

# see the results
knn_model$model_summary %>% t()

##                                       [,1]
## k                               14.0000000
## auc                              0.9528986
## auc_optimism_corrected           0.8916886
## auc_optimism_corrected_CIL       0.8212784
## auc_optimism_corrected_CIU       0.9415814
## accuracy                         0.8292683
## accuracy_optimism_corrected      0.7000703
## accuracy_optimism_corrected_CIL  0.6206897
## accuracy_optimism_corrected_CIU  0.8059615

roc_c

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_asv_tab,
                                     ileum_taxa_tab,
                                     ileum_metadata,
                                     group, usage="ml_ra")

## Removing 798 ASV(s)

## Removing 48 ASV(s)

# fit the model
knn_model <- knn_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(knn_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["knn_model_ra"]][[model_name]] <- knn_model$model_summary

supplements_models[["roc_cs"]][["knn_model_ra"]][[model_name]] <- knn_model$kfold_rocobjs

# see the results
knn_model$model_summary %>% t()

##                                       [,1]
## k                               15.0000000
## auc                              0.7213164
## auc_optimism_corrected           0.5957375
## auc_optimism_corrected_CIL       0.5095830
## auc_optimism_corrected_CIU       0.7305672
## accuracy                         0.6585366
## accuracy_optimism_corrected      0.5871462
## accuracy_optimism_corrected_CIL  0.5172414
## accuracy_optimism_corrected_CIU  0.7194056

roc_c

post_ltx vs healthy

group <- c("post_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_asv_tab,
                                     ileum_taxa_tab,
                                     ileum_metadata,
                                     group, usage="ml_ra")

## Removing 582 ASV(s)

## Removing 94 ASV(s)

# fit the model
knn_model <- knn_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(knn_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["knn_model_ra"]][[model_name]] <- knn_model$model_summary

supplements_models[["roc_cs"]][["knn_model_ra"]][[model_name]] <- knn_model$kfold_rocobjs

# see the results
knn_model$model_summary %>% t()

##                                       [,1]
## k                               10.0000000
## auc                              0.9347994
## auc_optimism_corrected           0.8689793
## auc_optimism_corrected_CIL       0.7805043
## auc_optimism_corrected_CIU       0.9406064
## accuracy                         0.8055556
## accuracy_optimism_corrected      0.7052182
## accuracy_optimism_corrected_CIL  0.5522500
## accuracy_optimism_corrected_CIU  0.8730769

roc_c

Genus level

level="genus"

Aggregate taxa

genus_data <- aggregate_taxa(ileum_asv_tab,
                             ileum_taxa_tab,
                             taxonomic_level = level)

ileum_genus_tab <- genus_data[[1]]
ileum_genus_taxa_tab <- genus_data[[2]]

pre_ltx vs healthy

group <- c("pre_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_genus_tab,
                                     ileum_genus_taxa_tab,
                                     ileum_metadata,
                                     group, 
                                     usage="ml_ra")

## Removing 37 ASV(s)

## Removing 6 ASV(s)

# fit the model
knn_model <- knn_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(knn_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["knn_model_ra"]][[model_name]] <- knn_model$model_summary

supplements_models[["roc_cs"]][["knn_model_ra"]][[model_name]] <- knn_model$kfold_rocobjs

# see the results
knn_model$model_summary %>% t()

##                                       [,1]
## k                               13.0000000
## auc                              0.9320652
## auc_optimism_corrected           0.8382346
## auc_optimism_corrected_CIL       0.7049526
## auc_optimism_corrected_CIU       0.9391406
## accuracy                         0.8048780
## accuracy_optimism_corrected      0.6880801
## accuracy_optimism_corrected_CIL  0.5846737
## accuracy_optimism_corrected_CIU  0.7785417

roc_c

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_genus_tab,
                                     ileum_genus_taxa_tab,
                                     ileum_metadata,
                                     group, 
                                     usage="ml_ra")

## Removing 30 ASV(s)

## Removing 5 ASV(s)

# fit the model
knn_model <- knn_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(knn_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["knn_model_ra"]][[model_name]] <- knn_model$model_summary

supplements_models[["roc_cs"]][["knn_model_ra"]][[model_name]] <- knn_model$kfold_rocobjs

# see the results
knn_model$model_summary %>% t()

##                                       [,1]
## k                               23.0000000
## auc                              0.6953502
## auc_optimism_corrected           0.5652388
## auc_optimism_corrected_CIL       0.4263759
## auc_optimism_corrected_CIU       0.7115888
## accuracy                         0.6219512
## accuracy_optimism_corrected      0.5487237
## accuracy_optimism_corrected_CIL  0.4599138
## accuracy_optimism_corrected_CIU  0.6132867

roc_c

post_ltx vs healthy

group <- c("post_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_genus_tab,
                                     ileum_genus_taxa_tab,
                                     ileum_metadata,
                                     group, 
                                     usage="ml_ra")

## Removing 53 ASV(s)

## Removing 5 ASV(s)

# fit the model
knn_model <- knn_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(knn_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["knn_model_ra"]][[model_name]] <- knn_model$model_summary

supplements_models[["roc_cs"]][["knn_model_ra"]][[model_name]] <- knn_model$kfold_rocobjs

# see the results
knn_model$model_summary %>% t()

##                                       [,1]
## k                               10.0000000
## auc                              0.9116512
## auc_optimism_corrected           0.8182651
## auc_optimism_corrected_CIL       0.7459353
## auc_optimism_corrected_CIU       0.8999087
## accuracy                         0.7916667
## accuracy_optimism_corrected      0.6976268
## accuracy_optimism_corrected_CIL  0.5868571
## accuracy_optimism_corrected_CIU  0.8550769

roc_c

Random Forest

ASV level

level="ASV"

pre_ltx vs healthy

group <- c("pre_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_asv_tab,
                                     ileum_taxa_tab,
                                     ileum_metadata,
                                     group, usage="ml_ra")

## Removing 532 ASV(s)

## Removing 83 ASV(s)

# fit the model
rf_model <- rf_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(rf_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["rf_model_ra"]][[model_name]] <- rf_model$model_summary

supplements_models[["roc_cs"]][["rf_model_ra"]][[model_name]] <- rf_model$kfold_rocobjs

# see the results
rf_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "17"       
## splitrule                       "gini"     
## min.node.size                   "2"        
## auc                             "1"        
## auc_optimism_corrected          "0.9847369"
## auc_optimism_corrected_CIL      "0.9549794"
## auc_optimism_corrected_CIU      "1"        
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.9214891"
## accuracy_optimism_corrected_CIL "0.8534965"
## accuracy_optimism_corrected_CIU "0.9925"

roc_c

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_asv_tab,
                                     ileum_taxa_tab,
                                     ileum_metadata,
                                     group, usage="ml_ra")

## Removing 798 ASV(s)

## Removing 48 ASV(s)

# fit the model
rf_model <- rf_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(rf_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["rf_model_ra"]][[model_name]] <- rf_model$model_summary

supplements_models[["roc_cs"]][["rf_model_ra"]][[model_name]] <- rf_model$kfold_rocobjs


# see the results
rf_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "145"      
## splitrule                       "gini"     
## min.node.size                   "5"        
## auc                             "1"        
## auc_optimism_corrected          "0.9643818"
## auc_optimism_corrected_CIL      "0.9189681"
## auc_optimism_corrected_CIU      "0.9960793"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.896525" 
## accuracy_optimism_corrected_CIL "0.7923368"
## accuracy_optimism_corrected_CIU "0.9655172"

roc_c

post_ltx vs healthy

group <- c("post_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_asv_tab,
                                     ileum_taxa_tab,
                                     ileum_metadata,
                                     group, usage="ml_ra")

## Removing 582 ASV(s)

## Removing 94 ASV(s)

# fit the model
rf_model <- rf_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(rf_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["rf_model_ra"]][[model_name]] <- rf_model$model_summary

supplements_models[["roc_cs"]][["rf_model_ra"]][[model_name]] <- rf_model$kfold_rocobjs


# see the results
rf_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "43"       
## splitrule                       "gini"     
## min.node.size                   "2"        
## auc                             "1"        
## auc_optimism_corrected          "0.9058463"
## auc_optimism_corrected_CIL      "0.7945391"
## auc_optimism_corrected_CIU      "0.998539" 
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.8109699"
## accuracy_optimism_corrected_CIL "0.6936667"
## accuracy_optimism_corrected_CIU "0.9356667"

roc_c

Genus level

level="genus"

Aggregate taxa

genus_data <- aggregate_taxa(ileum_asv_tab,
                             ileum_taxa_tab,
                             taxonomic_level = level)

ileum_genus_tab <- genus_data[[1]]
ileum_genus_taxa_tab <- genus_data[[2]]

pre_ltx vs healthy

group <- c("pre_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_genus_tab,
                                     ileum_genus_taxa_tab,
                                     ileum_metadata,
                                     group, 
                                     usage="ml_ra")

## Removing 37 ASV(s)

## Removing 6 ASV(s)

# fit the model
rf_model <- rf_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(rf_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["rf_model_ra"]][[model_name]] <- rf_model$model_summary

supplements_models[["roc_cs"]][["rf_model_ra"]][[model_name]] <- rf_model$kfold_rocobjs


# see the results
rf_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "35"       
## splitrule                       "gini"     
## min.node.size                   "2"        
## auc                             "1"        
## auc_optimism_corrected          "0.9653117"
## auc_optimism_corrected_CIL      "0.8524706"
## auc_optimism_corrected_CIU      "1"        
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.8969094"
## accuracy_optimism_corrected_CIL "0.7603117"
## accuracy_optimism_corrected_CIU "0.9935714"

roc_c

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_genus_tab,
                                     ileum_genus_taxa_tab,
                                     ileum_metadata,
                                     group, 
                                     usage="ml_ra")

## Removing 30 ASV(s)

## Removing 5 ASV(s)

# fit the model
rf_model <- rf_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(rf_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["rf_model_ra"]][[model_name]] <- rf_model$model_summary

supplements_models[["roc_cs"]][["rf_model_ra"]][[model_name]] <- rf_model$kfold_rocobjs


# see the results
rf_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "117"      
## splitrule                       "gini"     
## min.node.size                   "2"        
## auc                             "1"        
## auc_optimism_corrected          "0.9743134"
## auc_optimism_corrected_CIL      "0.9426692"
## auc_optimism_corrected_CIU      "1"        
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.8932112"
## accuracy_optimism_corrected_CIL "0.7743596"
## accuracy_optimism_corrected_CIU "0.9605303"

roc_c

post_ltx vs healthy

group <- c("post_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_genus_tab,
                                     ileum_genus_taxa_tab,
                                     ileum_metadata,
                                     group, 
                                     usage="ml_ra")

## Removing 53 ASV(s)

## Removing 5 ASV(s)

# fit the model
rf_model <- rf_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(rf_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["rf_model_ra"]][[model_name]] <- rf_model$model_summary

supplements_models[["roc_cs"]][["rf_model_ra"]][[model_name]] <- rf_model$kfold_rocobjs


# see the results
rf_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "19"       
## splitrule                       "gini"     
## min.node.size                   "2"        
## auc                             "1"        
## auc_optimism_corrected          "0.9438023"
## auc_optimism_corrected_CIL      "0.8844602"
## auc_optimism_corrected_CIU      "0.9973214"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.8638447"
## accuracy_optimism_corrected_CIL "0.8021429"
## accuracy_optimism_corrected_CIU "0.9223846"

roc_c

Gradient boosting

ASV level

level="ASV"

pre_ltx vs healthy

group <- c("pre_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_asv_tab,
                                     ileum_taxa_tab,
                                     ileum_metadata,
                                     group, usage="ml_ra")

## Removing 532 ASV(s)

## Removing 83 ASV(s)

# fit the model
gbm_model <- gbm_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(gbm_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["gbm_model_ra"]][[model_name]] <- gbm_model$model_summary

supplements_models[["roc_cs"]][["gbm_model_ra"]][[model_name]] <- gbm_model$kfold_rocobjs

# see the results
gbm_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "19"       
## splitrule                       "gini"     
## min.node.size                   "2"        
## auc                             "1"        
## auc_optimism_corrected          "0.9438023"
## auc_optimism_corrected_CIL      "0.8844602"
## auc_optimism_corrected_CIU      "0.9973214"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.8638447"
## accuracy_optimism_corrected_CIL "0.8021429"
## accuracy_optimism_corrected_CIU "0.9223846"

roc_c

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_asv_tab,
                                     ileum_taxa_tab,
                                     ileum_metadata,
                                     group, usage="ml_ra")

## Removing 798 ASV(s)

## Removing 48 ASV(s)

# fit the model
gbm_model <- gbm_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(gbm_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["gbm_model_ra"]][[model_name]] <- gbm_model$model_summary

supplements_models[["roc_cs"]][["gbm_model_ra"]][[model_name]] <- gbm_model$kfold_rocobjs

# see the results
gbm_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "19"       
## splitrule                       "gini"     
## min.node.size                   "2"        
## auc                             "1"        
## auc_optimism_corrected          "0.9438023"
## auc_optimism_corrected_CIL      "0.8844602"
## auc_optimism_corrected_CIU      "0.9973214"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.8638447"
## accuracy_optimism_corrected_CIL "0.8021429"
## accuracy_optimism_corrected_CIU "0.9223846"

roc_c

post_ltx vs healthy

group <- c("post_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_asv_tab,
                                     ileum_taxa_tab,
                                     ileum_metadata,
                                     group, usage="ml_ra")

## Removing 582 ASV(s)

## Removing 94 ASV(s)

# fit the model
gbm_model <- gbm_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(gbm_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["gbm_model_ra"]][[model_name]] <- gbm_model$model_summary

supplements_models[["roc_cs"]][["gbm_model_ra"]][[model_name]] <- gbm_model$kfold_rocobjs

# see the results
gbm_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "19"       
## splitrule                       "gini"     
## min.node.size                   "2"        
## auc                             "1"        
## auc_optimism_corrected          "0.9438023"
## auc_optimism_corrected_CIL      "0.8844602"
## auc_optimism_corrected_CIU      "0.9973214"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.8638447"
## accuracy_optimism_corrected_CIL "0.8021429"
## accuracy_optimism_corrected_CIU "0.9223846"

roc_c

Genus level

level="genus"

Aggregate taxa

genus_data <- aggregate_taxa(ileum_asv_tab,
                             ileum_taxa_tab,
                             taxonomic_level = level)

ileum_genus_tab <- genus_data[[1]]
ileum_genus_taxa_tab <- genus_data[[2]]

pre_ltx vs healthy

group <- c("pre_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_genus_tab,
                                     ileum_genus_taxa_tab,
                                     ileum_metadata,
                                     group, 
                                     usage="ml_ra")

## Removing 37 ASV(s)

## Removing 6 ASV(s)

# fit the model
gbm_model <- gbm_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(gbm_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["gbm_model_ra"]][[model_name]] <- gbm_model$model_summary

supplements_models[["roc_cs"]][["gbm_model_ra"]][[model_name]] <- gbm_model$kfold_rocobjs

# see the results
gbm_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "19"       
## splitrule                       "gini"     
## min.node.size                   "2"        
## auc                             "1"        
## auc_optimism_corrected          "0.9438023"
## auc_optimism_corrected_CIL      "0.8844602"
## auc_optimism_corrected_CIU      "0.9973214"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.8638447"
## accuracy_optimism_corrected_CIL "0.8021429"
## accuracy_optimism_corrected_CIU "0.9223846"

roc_c

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_genus_tab,
                                     ileum_genus_taxa_tab,
                                     ileum_metadata,
                                     group, 
                                     usage="ml_ra")

## Removing 30 ASV(s)

## Removing 5 ASV(s)

# fit the model
gbm_model <- gbm_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(gbm_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["gbm_model_ra"]][[model_name]] <- gbm_model$model_summary

supplements_models[["roc_cs"]][["gbm_model_ra"]][[model_name]] <- gbm_model$kfold_rocobjs

# see the results
gbm_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "19"       
## splitrule                       "gini"     
## min.node.size                   "2"        
## auc                             "1"        
## auc_optimism_corrected          "0.9438023"
## auc_optimism_corrected_CIL      "0.8844602"
## auc_optimism_corrected_CIU      "0.9973214"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.8638447"
## accuracy_optimism_corrected_CIL "0.8021429"
## accuracy_optimism_corrected_CIU "0.9223846"

roc_c

post_ltx vs healthy

group <- c("post_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_ileum_uni_data <- binomial_prep(ileum_genus_tab,
                                     ileum_genus_taxa_tab,
                                     ileum_metadata,
                                     group, 
                                     usage="ml_ra")

## Removing 53 ASV(s)

## Removing 5 ASV(s)

# fit the model
gbm_model <- gbm_binomial(filt_ileum_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(gbm_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["gbm_model_ra"]][[model_name]] <- gbm_model$model_summary

supplements_models[["roc_cs"]][["gbm_model_ra"]][[model_name]] <- gbm_model$kfold_rocobjs

# see the results
gbm_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "19"       
## splitrule                       "gini"     
## min.node.size                   "2"        
## auc                             "1"        
## auc_optimism_corrected          "0.9438023"
## auc_optimism_corrected_CIL      "0.8844602"
## auc_optimism_corrected_CIU      "0.9973214"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.8638447"
## accuracy_optimism_corrected_CIL "0.8021429"
## accuracy_optimism_corrected_CIU "0.9223846"

roc_c

Saving results

models_list <- list()

for (model_name in names(supplements_models$models_summ)){
  df <- do.call(rbind, supplements_models$models_summ[[model_name]])
  models_list[[model_name]] <- df
}

write.xlsx(models_list,
           file=file.path(path,paste0("supplements_models_",segment,".xlsx")),
           rowNames=TRUE)

Results overview

Alpha diversity

pc_observed[[segment]]

pc_shannon[[segment]]

pc_simpson[[segment]]

pc_pielou[[segment]]

alpha_div_plots[[paste(segment,"Custom")]]

Beta diversity

Main results

pairwise_aitchison_raw[[paste("genus", segment)]]

PCA

pca_plots_list[[paste(segment,"genus custom")]]

Supplements

knitr::kable(supplements_beta[!grepl("PCoA",names(supplements_beta))],
             digits = 3,
             caption = "Supplementary PERMANOVA results")

Supplementary PERMANOVA results

pairs Df SumsOfSqs F.Model R2 p.value p.adjusted sig pre_ltx vs healthy 1 1.000 5.257 0.062 0.001 0.002 ** pre_ltx vs post_ltx 1 0.442 2.053 0.025 0.011 0.011 * post_ltx vs healthy 1 1.165 6.012 0.079 0.001 0.002 **

pairs Df SumsOfSqs F.Model R2 p.value p.adjusted sig pre_ltx vs healthy 1 1.114 4.010 0.048 0.001 0.002 ** pre_ltx vs post_ltx 1 0.512 1.694 0.021 0.013 0.013 * post_ltx vs healthy 1 1.225 4.313 0.058 0.001 0.002 **

pairs Df SumsOfSqs F.Model R2 p.value p.adjusted sig pre_ltx vs healthy 1 1022.375 3.249 0.039 0.001 0.001 *** pre_ltx vs post_ltx 1 500.838 1.753 0.021 0.001 0.001 *** post_ltx vs healthy 1 975.120 3.241 0.044 0.001 0.001 ***

pairs Df SumsOfSqs F.Model R2 p.value p.adjusted sig pre_ltx vs healthy 1 1.502 4.843 0.057 0.001 0.002 ** pre_ltx vs post_ltx 1 0.648 1.964 0.024 0.004 0.004 ** post_ltx vs healthy 1 1.599 5.137 0.068 0.001 0.002 **

pairs Df SumsOfSqs F.Model R2 p.value p.adjusted sig pre_ltx vs healthy 1 1.275 3.334 0.040 0.001 0.002 ** pre_ltx vs post_ltx 1 0.626 1.579 0.019 0.003 0.003 ** post_ltx vs healthy 1 1.319 3.438 0.047 0.001 0.002 **

PCA

ggarrange(plotlist = supplements_beta[grepl("PCoA",names(supplements_beta))],
          labels=names(supplements_beta[grepl("PCoA",names(supplements_beta))]),
          font.label = list(size=5,face="plain"),
          ncol=2,nrow=3)

Univariate analysis

Number of significant taxa

knitr::kable(cbind(as.data.frame(lapply(list_intersections,nrow)),
      as.data.frame(lapply(psc_effect,nrow))) %>% t() %>% 
  `colnames<-`("Count") %>% 
  `rownames<-`(c(names(list_intersections),"PSC effect ASV","PSC effect Genus","PSC effect Phylum")),caption="Number of significant taxa")

Number of significant taxa

	Count
terminal_ileum genus healthy vs pre_ltx	44
terminal_ileum genus pre_ltx vs post_ltx	11
terminal_ileum genus healthy vs post_ltx	31
terminal_ileum ASV healthy vs pre_ltx	40
terminal_ileum ASV pre_ltx vs post_ltx	8
terminal_ileum ASV healthy vs post_ltx	31
terminal_ileum phylum healthy vs pre_ltx	2
terminal_ileum phylum pre_ltx vs post_ltx	0
terminal_ileum phylum healthy vs post_ltx	2
PSC effect ASV	21
PSC effect Genus	12
PSC effect Phylum	2

Machine learning

Main models

Summary

knitr::kable(models_summ_df_ileum %>% dplyr::select(
"alpha","lambda",
"auc_optimism_corrected",
"auc_optimism_corrected_CIL",
"auc_optimism_corrected_CIU"),
             digits=2,caption="Elastic net results")

Elastic net results

	alpha	lambda	auc_optimism_corrected	auc_optimism_corrected_CIL	auc_optimism_corrected_CIU
pre_ltx vs healthy ASV terminal_ileum	0.2	0.08	0.94	0.91	0.97
pre_ltx vs post_ltx ASV terminal_ileum	0.4	0.05	0.95	0.91	0.98
post_ltx vs healthy ASV terminal_ileum	0.2	0.04	0.94	0.80	1.00
pre_ltx vs healthy genus terminal_ileum	0.4	0.02	0.95	0.87	0.99
pre_ltx vs post_ltx genus terminal_ileum	1.0	0.05	0.97	0.90	1.00
post_ltx vs healthy genus terminal_ileum	0.2	0.19	0.92	0.79	0.99

ROC - ASV level

roc_curve_all_custom(roc_cs[c(1:3)], 
                     Q="Q1_norway",
                     model_name="enet_model")

ROC - Genus level

roc_curve_all_custom(roc_cs[c(4:6)],Q="Q1_norway",
                     model_name="enet_model")

Supplementary models

Summary

# Build final dataframe
models_list[["enet_model"]] <- models_summ_df_ileum
final_df <- tibble(row_names = rownames(models_list[[1]]))

# Loop through models and extract required values
for (model_name in names(models_list)) {
  model_df <- models_list[[model_name]]
  
  # Combine AUC_optimism_corrected with its CI values
  final_df[[model_name]] <- paste0(
    round(model_df$auc_optimism_corrected, 3), 
    " (", round(model_df$auc_optimism_corrected_CIL, 3), "; ", 
    round(model_df$auc_optimism_corrected_CIU, 3), ")"
  )
}

knitr::kable(final_df, caption="All models")

All models

row_names	knn_model	rf_model	gbm_model	enet_model_ra	knn_model_ra	rf_model_ra	gbm_model_ra	enet_model
pre_ltx vs healthy ASV terminal_ileum	0.869 (0.781; 0.922)	0.946 (0.829; 0.994)	0.927 (0.858; 0.995)	0.884 (0.77; 0.97)	0.892 (0.821; 0.942)	0.985 (0.955; 1)	0.944 (0.884; 0.997)	0.939 (0.907; 0.969)
pre_ltx vs post_ltx ASV terminal_ileum	0.773 (0.675; 0.879)	0.941 (0.89; 0.99)	0.927 (0.858; 0.995)	0.775 (0.569; 0.891)	0.596 (0.51; 0.731)	0.964 (0.919; 0.996)	0.944 (0.884; 0.997)	0.949 (0.906; 0.979)
post_ltx vs healthy ASV terminal_ileum	0.898 (0.779; 0.997)	0.926 (0.855; 1)	0.927 (0.858; 0.995)	0.879 (0.772; 0.995)	0.869 (0.781; 0.941)	0.906 (0.795; 0.999)	0.944 (0.884; 0.997)	0.941 (0.799; 1)
pre_ltx vs healthy genus terminal_ileum	0.892 (0.745; 0.964)	0.958 (0.854; 0.995)	0.927 (0.858; 0.995)	0.901 (0.812; 0.99)	0.838 (0.705; 0.939)	0.965 (0.852; 1)	0.944 (0.884; 0.997)	0.945 (0.868; 0.994)
pre_ltx vs post_ltx genus terminal_ileum	0.76 (0.655; 0.92)	0.93 (0.9; 0.956)	0.927 (0.858; 0.995)	0.647 (0.493; 0.836)	0.565 (0.426; 0.712)	0.974 (0.943; 1)	0.944 (0.884; 0.997)	0.969 (0.905; 1)
post_ltx vs healthy genus terminal_ileum	0.913 (0.857; 0.988)	0.927 (0.858; 0.995)	0.927 (0.858; 0.995)	0.9 (0.809; 0.986)	0.818 (0.746; 0.9)	0.944 (0.884; 0.997)	0.944 (0.884; 0.997)	0.918 (0.789; 0.992)

ROC - ASV

rocs_list <- supplements_models$roc_cs
rocs_list[["enet_model"]] <- roc_cs

plot_list <- list()

for (model_name in names(rocs_list)) {
  plot_list[[model_name]] <- roc_curve_all_custom(rocs_list[[model_name]][c(1:3)],
                       Q="Q1_norway",
                       model_name=model_name)
}

ggarrange(plotlist = plot_list,labels = names(rocs_list),font.label = list(face="plain",size=7))

ROC - genus

plot_list <- list()

for (model_name in names(rocs_list)) {
  plot_list[[model_name]] <- roc_curve_all_custom(rocs_list[[model_name]][c(4:6)],
                       Q="Q1_norway",
                       model_name=model_name)
}

ggarrange(plotlist = plot_list,labels = names(rocs_list),font.label = list(face="plain",size=7))

Analysis - Colon

segment="colon"

Filtering

Rules: - prevalence > 5% (per group) - nearZeroVar with default settings - sequencing depth > 5000 - taxonomic assignment at least order

Library size

read_counts(colon_asv_tab, line = c(5000,10000))

## Scale for y is already present.
## Adding another scale for y, which will replace the existing scale.

Sequencing depth

data_filt <- seq_depth_filtering(colon_asv_tab,
                                 colon_taxa_tab,
                                 colon_metadata,
                                 seq_depth_threshold = 10000)

## Removing 85 ASV(s)

filt_colon_asv_tab <- data_filt[[1]]; alpha_colon_asv_tab <- filt_colon_asv_tab
filt_colon_taxa_tab <- data_filt[[2]]; alpha_colon_taxa_tab <- filt_colon_taxa_tab
filt_colon_metadata <- data_filt[[3]]; alpha_colon_metadata <- filt_colon_metadata

seq_step <- dim(filt_colon_asv_tab)[1]

Library size

read_counts(filt_colon_asv_tab,line = c(10000))

## Scale for y is already present.
## Adding another scale for y, which will replace the existing scale.

NearZeroVar

data_filt <- nearzerovar_filtering(filt_colon_asv_tab,
                                   filt_colon_taxa_tab,
                                   filt_colon_metadata)

filt_colon_asv_tab <- data_filt[[1]]
filt_colon_taxa_tab <- data_filt[[2]]
nearzero_step <- dim(filt_colon_asv_tab)[1]

Library size

read_counts(filt_colon_asv_tab,line = c(5000,10000))

## Scale for y is already present.
## Adding another scale for y, which will replace the existing scale.

Check zero depth

data_filt <- check_zero_depth(filt_colon_asv_tab, 
                              filt_colon_taxa_tab, 
                              filt_colon_metadata)

filt_colon_asv_tab <- data_filt[[1]]; 
filt_colon_taxa_tab <- data_filt[[2]]; 
filt_colon_metadata <- data_filt[[3]]; 

Library size

read_counts(filt_colon_asv_tab,line = c(5000,10000))

## Scale for y is already present.
## Adding another scale for y, which will replace the existing scale.

Final Counts

final_counts_filtering(colon_asv_tab,
                       filt_colon_asv_tab,
                       filt_colon_metadata,
                       seq_step, 0, nearzero_step)

Alpha diversity

path = "../results/Q1_norway/alpha_diversity"

Calculation

# Construct MPSE object
alpha_colon_metadata$Sample <- alpha_colon_metadata$SampleID
colon_mpse <- as.MPSE(construct_phyloseq(alpha_colon_asv_tab,
                                         alpha_colon_taxa_tab,
                                         alpha_colon_metadata))

colon_mpse %<>% mp_rrarefy(raresize = 10000,seed = 123)

# Calculate alpha diversity - rarefied counts
colon_mpse %<>% mp_cal_alpha(.abundance=RareAbundance, force=TRUE)

alpha_data <- data.frame(SampleID=colon_mpse$Sample.x,
                         Observe=colon_mpse$Observe,
                         Shannon=colon_mpse$Shannon,
                         Simpson=colon_mpse$Simpson,
                         Pielou=colon_mpse$Pielou,
                         Group=colon_mpse$Group,
                         Country=colon_mpse$Country,
                         Patient=colon_mpse$Patient)

write.csv(alpha_data,file.path(path,paste0("alpha_indices_",segment,".csv")),
          row.names = FALSE)

Plots

Custom plot

alpha_data <- alpha_data %>% 
  dplyr::select(-c("Simpson","Pielou")) %>%
  mutate(Richness=Observe)

p_B <- alpha_diversity_custom_2(alpha_data,
                                size = 1.5,
                                width = 0.3)

## Scale for y is already present.
## Adding another scale for y, which will replace the existing scale.
## Scale for y is already present.
## Adding another scale for y, which will replace the existing scale.

# save the results
alpha_div_plots[[paste(segment,"Custom")]] <- p_B

p_B

Linear Model

path = "../results/Q1_norway/alpha_diversity"
alpha_data <- read.csv(file.path(path,paste0("alpha_indices_",segment,".csv")))

Richness

results_model <- pairwise.lmer(
  formula = "Observe ~ Group + (1|Patient)",
  factors=alpha_data$Group,
  data=alpha_data)

# check interaction
if (!is.data.frame(results_model)){
  results_model_observe <- results_model[[1]]
  results_model_observe_detailed <- results_model[[2]]
} else {
  results_model_observe <- results_model
  results_model_observe_detailed <- NA
}

# save the results
pc_observed[[segment]] <- results_model_observe

# see the results
knitr::kable(results_model_observe,digits = 3,
caption = "Raw results of linear model of richness estimation.")

Raw results of linear model of richness estimation.

	Estimate	Std..Error	df	t.value	Pr…t..	p.adj	sig
healthy vs Grouppre_ltx	-62.898	9.494	116.518	-6.625	0.000	0.000	***
pre_ltx vs Grouppost_ltx	4.619	9.148	129.233	0.505	0.614	0.614
healthy vs Grouppost_ltx	-58.354	11.528	87.226	-5.062	0.000	0.000	***

# see the results
knitr::kable(results_model[[3]],digits = 3,
caption = "Group means")

Group means

	Estimate	Std. Error	df	t value	Pr(>|t|)
healthy	185.593	8.821	89.016	21.039	0
pre_ltx	122.610	5.712	129.619	21.465	0
healthy	185.504	7.869	117.622	23.573	0

Shannon

results_model <- pairwise.lmer(
  formula = "Shannon ~ Group + (1|Patient)",
  factors=alpha_data$Group,
  data=alpha_data)

# check interaction
if (!is.data.frame(results_model)){
  results_model_shannon <- results_model[[1]]
  results_model_shannon_detailed <- results_model[[2]]
} else {
  results_model_shannon <- results_model
  results_model_shannon_detailed <- NA
}

# save the results
pc_shannon[[segment]] <- as.data.frame(results_model_shannon)

# see the results
knitr::kable(results_model_shannon,digits = 3,
caption = "Raw results of linear model of Shannon estimation.")

Raw results of linear model of Shannon estimation.

	Estimate	Std..Error	df	t.value	Pr…t..	p.adj	sig
healthy vs Grouppre_ltx	-0.504	0.122	117.486	-4.132	0.000	0.000	***
pre_ltx vs Grouppost_ltx	-0.090	0.125	129.047	-0.719	0.473	0.473
healthy vs Grouppost_ltx	-0.595	0.136	88.014	-4.388	0.000	0.000	***

# see the results
knitr::kable(results_model[[3]],digits = 3,
caption = "Group means")

Group means

	Estimate	Std. Error	df	t value	Pr(>|t|)
healthy	3.702	0.104	90.080	35.652	0
pre_ltx	3.197	0.078	129.527	40.945	0
healthy	3.701	0.101	118.959	36.557	0

Simpson

results_model <- pairwise.lmer(
  formula = "Simpson ~ Group + (1|Patient)",
  factors=alpha_data$Group,
  data=alpha_data)

# check interaction
if (!is.data.frame(results_model)){
  results_model_simpson <- results_model[[1]]
  results_model_simpson_detailed <- results_model[[2]]
} else {
  results_model_simpson <- results_model
  results_model_simpson_detailed <- NA
}

# save the results
pc_simpson[[segment]] <- as.data.frame(results_model_simpson)

# see the results
knitr::kable(results_model_simpson,digits = 3,
caption = "Raw results of linear model of Simpson estimation.")

Raw results of linear model of Simpson estimation.

	Estimate	Std..Error	df	t.value	Pr…t..	p.adj	sig
healthy vs Grouppre_ltx	-0.039	0.017	117.614	-2.257	0.026	0.039	*
pre_ltx vs Grouppost_ltx	-0.020	0.020	128.829	-1.000	0.319	0.319
healthy vs Grouppost_ltx	-0.059	0.022	89.578	-2.624	0.010	0.031	*

# see the results
knitr::kable(results_model[[3]],digits = 3,
caption = "Group means")

Group means

	Estimate	Std. Error	df	t value	Pr(>|t|)
healthy	0.936	0.017	91.967	54.406	0
pre_ltx	0.898	0.013	129.371	71.003	0
healthy	0.936	0.014	119.443	65.975	0

Pielou

results_model <- pairwise.lmer(
  formula = "Pielou ~ Group + (1|Patient)",
  factors=alpha_data$Group,
  data=alpha_data)

# check interaction
if (!is.data.frame(results_model)){
  results_model_pielou <- results_model[[1]]
  results_model_pielou_detailed <- results_model[[2]]
} else {
  results_model_pielou <- results_model
  results_model_pielou_detailed <- NA
}

# save the results
pc_pielou[[segment]] <- as.data.frame(results_model_pielou)

# see the results
knitr::kable(results_model_pielou,digits = 3,
caption = "Raw results of linear model of Pielou estimation.")

Raw results of linear model of Pielou estimation.

	Estimate	Std..Error	df	t.value	Pr…t..	p.adj	sig
healthy vs Grouppre_ltx	-0.043	0.017	118.548	-2.473	0.015	0.022	*
pre_ltx vs Grouppost_ltx	-0.022	0.019	128.797	-1.198	0.233	0.233
healthy vs Grouppost_ltx	-0.066	0.021	89.175	-3.175	0.002	0.006	**

# see the results
knitr::kable(results_model[[3]],digits = 3,
caption = "Group means")

Group means

	Estimate	Std. Error	df	t value	Pr(>|t|)
healthy	0.713	0.016	92.000	44.991	0
pre_ltx	0.670	0.012	129.484	57.506	0
healthy	0.713	0.015	120.936	49.176	0

Saving results

alpha_list <- list(
  Richness=pc_observed[[segment]] %>% rownames_to_column("Comparison"),
  Shannon=pc_shannon[[segment]] %>% rownames_to_column("Comparison"),
  Simpson=pc_simpson[[segment]] %>% rownames_to_column("Comparison"),
  Pielou=pc_pielou[[segment]] %>% rownames_to_column("Comparison"))
                   
write.xlsx(alpha_list, 
           file = file.path(path,paste0("alpha_diversity_results_",segment,".xlsx")))

Beta diversity

Calculating Aitchison distance (euclidean distance on clr-transformed data), both at ASV and genus level.

Main analysis - Genus, Aitchison

Genus level, Aitchison distance

level="genus"

path = "../results/Q1_norway/beta_diversity"

Aggregation, filtering

# Aggregation
genus_data <- aggregate_taxa(colon_asv_tab,
                             colon_taxa_tab,
                             taxonomic_level=level,
                             names=TRUE)
# Filtration
filt_data <- filtering_steps(genus_data[[1]],
                             genus_data[[2]],
                             colon_metadata,
                             seq_depth_threshold=10000)

## Removing 13 ASV(s)

filt_colon_genus_tab <- filt_data[[1]]
filt_colon_genus_taxa <- filt_data[[2]]
filt_colon_genus_metadata <- filt_data[[3]]

PERMANOVA

pairwise_df <- filt_colon_genus_tab %>% column_to_rownames("SeqID") %>% t()

# main effect
pp_main <- pairwise.adonis(pairwise_df,filt_colon_genus_metadata$Group,
                           covariate = NULL, 
                           patients = filt_colon_genus_metadata$Patient,
                           sim.method = "robust.aitchison", p.adjust.m="BH")


# tidy the results
pp_factor <- pp_main

cols <- c("pairs","Df","SumsOfSqs", "F.Model","R2","p.value", "p.adjusted", "sig")
colnames(pp_factor) <- cols

# save raw results
pairwise_aitchison_raw[[paste(level, segment)]] <- pp_factor

# see the results
knitr::kable(pp_factor,digits = 3,caption = "PERMANOVA, GROUP separation")

PERMANOVA, GROUP separation

pairs	Df	SumsOfSqs	F.Model	R2	p.value	p.adjusted	sig
pre_ltx vs healthy	1	1251.076	8.029	0.029	0.001	0.002	**
pre_ltx vs post_ltx	1	623.098	3.943	0.011	0.075	0.075
post_ltx vs healthy	1	1372.514	8.545	0.040	0.001	0.002	**

Plots

Custom

p <- pca_plot_custom(filt_colon_genus_tab,
                                 filt_colon_genus_taxa,
                                 filt_colon_genus_metadata,
                                 show_boxplots = TRUE,
                                 variable = "Group", size=3, show_legend=TRUE)

# save the results
pca_plots_list[[paste(segment,level,"custom")]] <- p

# see the results
p

Saving results

write.xlsx(pairwise_aitchison_raw[[paste(level, segment)]], 
           file = file.path(path,
           paste0("beta_diversity_results_", segment,".xlsx")))

Supplementary analysis

Genus level

level="genus"

Bray-Curtis

PERMANOVA

pairwise_df <- filt_colon_genus_tab %>% column_to_rownames("SeqID") %>% t()

# main effect
pp_main <- pairwise.adonis(pairwise_df,filt_colon_genus_metadata$Group,
                           covariate = NULL, 
                            patients = filt_colon_genus_metadata$Patient,
                           sim.method = "bray", p.adjust.m="BH")


# tidy the results
pp_factor <- pp_main

cols <- c("pairs","Df","SumsOfSqs", "F.Model","R2","p.value", "p.adjusted", "sig")
colnames(pp_factor) <- cols

# save raw results
supplements_beta[[paste("bray",level,segment)]] <- pp_factor

# see the results
knitr::kable(pp_factor,digits = 3,caption = "PERMANOVA, GROUP separation")

PERMANOVA, GROUP separation

pairs	Df	SumsOfSqs	F.Model	R2	p.value	p.adjusted	sig
pre_ltx vs healthy	1	2.224	10.918	0.039	0.001	0.002	**
pre_ltx vs post_ltx	1	1.173	5.414	0.015	0.052	0.052
post_ltx vs healthy	1	2.984	14.912	0.068	0.001	0.002	**

Plots

p <- pca_plot_custom(filt_colon_genus_tab,
                                 filt_colon_genus_taxa,
                                 filt_colon_genus_metadata,
                                 measure = "bray",
                                 show_boxplots = TRUE,
                                 variable = "Group", size=3, show_legend=TRUE)

# save the results
supplements_beta[[paste("PCoA bray",level,segment)]] <- p

# see the results
p

Jaccard

PERMANOVA

pairwise_df <- filt_colon_genus_tab %>% column_to_rownames("SeqID") %>% t()

# main effect
pp_main <- pairwise.adonis(pairwise_df,filt_colon_genus_metadata$Group,
                           covariate = NULL, 
                            patients = filt_colon_genus_metadata$Patient,
                           sim.method = "jaccard", p.adjust.m="BH")


# tidy the results
pp_factor <- pp_main

cols <- c("pairs","Df","SumsOfSqs", "F.Model","R2","p.value", "p.adjusted", "sig")
colnames(pp_factor) <- cols

# save raw results
supplements_beta[[paste("jaccard",level,segment)]] <- pp_factor

# see the results
knitr::kable(pp_factor,digits = 3,caption = "PERMANOVA, GROUP separation")

PERMANOVA, GROUP separation

pairs	Df	SumsOfSqs	F.Model	R2	p.value	p.adjusted	sig
pre_ltx vs healthy	1	2.407	8.288	0.030	0.001	0.002	**
pre_ltx vs post_ltx	1	1.254	4.150	0.012	0.078	0.078
post_ltx vs healthy	1	3.048	10.592	0.049	0.001	0.002	**

Plots

Custom

p <- pca_plot_custom(filt_colon_genus_tab,
                                 filt_colon_genus_taxa,
                                 filt_colon_genus_metadata,
                                 measure = "jaccard",
                                 show_boxplots = TRUE,
                                 variable = "Group", size=3, show_legend=TRUE)

# save the results
supplements_beta[[paste("PCoA jaccard",level,segment)]] <- p

# see the results
p

ASV level

level="ASV"

Aitchison

PERMANOVA

# preparing data frame
pairwise_df <- filt_colon_asv_tab %>% column_to_rownames("SeqID") %>% t()

# main effect
pp_main <- pairwise.adonis(pairwise_df,filt_colon_metadata$Group,
                           covariate = NULL, 
                            patients = filt_colon_metadata$Patient,
                           sim.method = "robust.aitchison", p.adjust.m="BH")


# tidy the results
pp_factor <- pp_main

cols <- c("pairs","Df","SumsOfSqs", "F.Model","R2","p.value", "p.adjusted", "sig")
colnames(pp_factor) <- cols

# save raw results
supplements_beta[[paste("aitchison",level,segment)]] <- pp_factor

# see the results
knitr::kable(pp_factor,digits = 3,caption = "PERMANOVA, GROUP separation")

PERMANOVA, GROUP separation

pairs	Df	SumsOfSqs	F.Model	R2	p.value	p.adjusted	sig
pre_ltx vs healthy	1	2143.719	7.928	0.028	0.001	0.002	**
pre_ltx vs post_ltx	1	936.918	3.682	0.011	0.109	0.109
post_ltx vs healthy	1	2087.993	7.806	0.037	0.001	0.002	**

PCoA

p <- pca_plot_custom(filt_colon_asv_tab,
                           filt_colon_taxa_tab,
                           filt_colon_metadata,
                           show_boxplots = TRUE,
                           variable = "Group", size=3, show_legend=TRUE)

# save the results
supplements_beta[[paste("PCoA aitchison",level,segment)]] <- p

# see the results
p

Bray-Curtis

PERMANOVA

# preparing data frame
pairwise_df <- filt_colon_asv_tab %>% column_to_rownames("SeqID") %>% t()

# main effect
pp_main <- pairwise.adonis(pairwise_df,filt_colon_metadata$Group,
                           covariate = NULL, 
                           patients = filt_colon_metadata$Patient,
                           sim.method = "bray", p.adjust.m="BH")


# tidy the results
pp_factor <- pp_main

cols <- c("pairs","Df","SumsOfSqs", "F.Model","R2","p.value", "p.adjusted", "sig")
colnames(pp_factor) <- cols

# save raw results
supplements_beta[[paste("bray",level,segment)]] <- pp_factor

# see the results
knitr::kable(pp_factor,digits = 3,caption = "PERMANOVA, GROUP separation")

PERMANOVA, GROUP separation

pairs	Df	SumsOfSqs	F.Model	R2	p.value	p.adjusted	sig
pre_ltx vs healthy	1	3.231	9.892	0.035	0.001	0.002	**
pre_ltx vs post_ltx	1	1.822	5.456	0.015	0.010	0.010	**
post_ltx vs healthy	1	4.004	12.790	0.059	0.001	0.002	**

PCoA

p <- pca_plot_custom(filt_colon_asv_tab,
                     filt_colon_taxa_tab,
                     filt_colon_metadata,
                     measure = "bray",
                     show_boxplots = TRUE,
                     variable = "Group", size=3, show_legend=TRUE)

# save the results
supplements_beta[[paste("PCoA bray",level,segment)]] <- p

# see the results
p

Jaccard

PERMANOVA

# preparing data frame
pairwise_df <- filt_colon_asv_tab %>% column_to_rownames("SeqID") %>% t()

# main effect
pp_main <- pairwise.adonis(pairwise_df,filt_colon_metadata$Group,
                           covariate = NULL, 
                           patients = filt_colon_metadata$Patient,
                           sim.method = "jaccard", p.adjust.m="BH")


# tidy the results
pp_factor <- pp_main

cols <- c("pairs","Df","SumsOfSqs", "F.Model","R2","p.value", "p.adjusted", "sig")
colnames(pp_factor) <- cols

# save raw results
supplements_beta[[paste("jaccard",level,segment)]] <- pp_factor

# see the results
knitr::kable(pp_factor,digits = 3,caption = "PERMANOVA, GROUP separation")

PERMANOVA, GROUP separation

pairs	Df	SumsOfSqs	F.Model	R2	p.value	p.adjusted	sig
pre_ltx vs healthy	1	2.614	6.644	0.024	0.001	0.002	**
pre_ltx vs post_ltx	1	1.649	4.143	0.012	0.031	0.031	*
post_ltx vs healthy	1	3.192	8.331	0.039	0.001	0.002	**

PCoA

p <- pca_plot_custom(filt_colon_asv_tab,
                     filt_colon_taxa_tab,
                     filt_colon_metadata,
                     measure = "jaccard",
                     show_boxplots = TRUE,
                     variable = "Group", size=3, show_legend=TRUE)

# save the results
supplements_beta[[paste("PCoA jaccard",level,segment)]] <- p

# see the results
p

Saving results

write.xlsx(supplements_beta[!grepl("PCoA",names(supplements_beta))],
           file = file.path(path,
           paste0("supplements_beta_diversity_", segment,".xlsx")))

Univariate Analysis

Main - Genus level

level="genus"

# needed paths
path = "../results/Q1_norway/univariate_analysis"
path_maaslin=file.path("../intermediate_files/maaslin/Q1_norway/",level)

# variables
raw_linda_results_genus[[segment]] <- list()
linda_results_genus[[segment]] <- list()

# country and interaction problems
list_country_union <- list()
list_intersections <- list()
list_venns <- list()
uni_statistics <- list()

# workbook for final df
wb <- createWorkbook()

# PSC effect
psc_effect <- list()

Genus level

level="genus"

Aggregate taxa

genus_data <- aggregate_taxa(colon_asv_tab,
                             colon_taxa_tab,
                             taxonomic_level = level)

colon_genus_tab <- genus_data[[1]]
colon_genus_taxa_tab <- genus_data[[2]]

colon_genus_asv_taxa_tab <- create_asv_taxa_table(colon_genus_tab,
                                                  colon_genus_taxa_tab)

pre_ltx vs healthy

linDA

group <- c("healthy","pre_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

# prepare the data
linda_data <- binomial_prep(colon_genus_tab,
                            colon_genus_taxa_tab,
                            colon_metadata,
                            group, usage="linDA")

## Removing 54 ASV(s)

## Removing 11 ASV(s)

filt_colon_uni_data <- linda_data[[1]]
filt_colon_uni_taxa <- linda_data[[2]]
filt_colon_uni_metadata <- linda_data[[3]]

# fit the model
linda.obj <- linda(filt_colon_uni_data,
                   filt_colon_uni_metadata,
                   formula = '~ Group + (1|Patient)')

## 0  features are filtered!
## The filtered data has  274  samples and  167  features will be tested!
## Pseudo-count approach is used.
## Fit linear mixed effects models ...
## Completed.

linda.output <- linda.obj$output
linda.output <- linda_renaming(linda.output, group)

# save the results
group1 <- paste0(group[1], " vs ","Group",group[2])


for (grp in c(group1)){
  raw_linda_results_genus[[segment]][[grp]] <- 
    rawlinda.df(linda.output,
                grp,
                filt_colon_uni_data,
                filt_colon_uni_taxa)
  
  linda_results_genus[[segment]][[grp]] <- 
    linda.df(linda.output,
             grp,
             filt_colon_uni_data,
             filt_colon_uni_taxa)
}

# volcano plot
volcano_1 <- volcano_plot_linda(linda.output, group1, 
                                taxa_table = filt_colon_uni_taxa) + 
            ggtitle(paste(group,collapse=" vs "))


volcano <- ggarrange(volcano_1)

# see the plot
volcano

## Warning: ggrepel: 6 unlabeled data points (too many overlaps). Consider increasing max.overlaps

MaAsLin2

volcano1 <- volcano_plot_maaslin(fit_data,filt_colon_uni_taxa) + 
            ggtitle(paste(group[1], "vs", group[2]))


volcano <- ggarrange(volcano1)

## Warning: Removed 28 rows containing missing values or values outside the scale range (`geom_text_repel()`).

volcano

Group - Intersection

intersection_results <- group_intersection(group, list_intersections, list_venns,
                                           linda.output, fit_data,
                                           raw_linda_results_genus, 
                                           segment = segment,
                                           level=level)

list_intersections <- intersection_results[[1]]
list_venns <- intersection_results[[2]]
venn <- intersection_results[[3]]

# show the results
venn

Basic statistics

uni_df <-  merge(basic_univariate_statistics(linda_data,group),
                 raw_linda_results_genus[[segment]][[group1]],
                 by="SeqID",all=TRUE)

## [1] "healthy"
## [1] "pre_ltx"
## [1] "healthy"
## [1] "pre_ltx"

uni_df[["final_sig"]] <- uni_df$SeqID %in% list_intersections[[paste(segment,level,comparison_name)]][["SeqID"]]
uni_statistics[[segment]][[paste(level,comparison_name)]] <- uni_df

# for comparison
new_name <- comparison_name
addWorksheet(wb, sheetName = new_name)
writeData(wb, sheet = new_name, uni_df, rowNames=FALSE)

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

linDA

# prepare the data
linda_data <- binomial_prep(colon_genus_tab,
                            colon_genus_taxa_tab,
                            colon_metadata,
                            group, usage="linDA")

## Removing 18 ASV(s)

## Removing 13 ASV(s)

filt_colon_uni_data <- linda_data[[1]]
filt_colon_uni_taxa <- linda_data[[2]]
filt_colon_uni_metadata <- linda_data[[3]]

# fit the model
linda.obj <- linda(filt_colon_uni_data,
                   filt_colon_uni_metadata,
                   formula = '~ Group + (1|Patient)')

## 0  features are filtered!
## The filtered data has  349  samples and  140  features will be tested!
## Pseudo-count approach is used.
## Fit linear mixed effects models ...
## Completed.

linda.output <- linda.obj$output
linda.output <- linda_renaming(linda.output, group)

# save the results
group1 <- paste0(group[1], " vs ","Group",group[2])


for (grp in c(group1)){
  raw_linda_results_genus[[segment]][[grp]] <- 
    rawlinda.df(linda.output,
                grp,
                filt_colon_uni_data,
                filt_colon_uni_taxa)
  
  linda_results_genus[[segment]][[grp]] <- 
    linda.df(linda.output,
             grp,
             filt_colon_uni_data,
             filt_colon_uni_taxa)
}

# volcano plot
volcano_1 <- volcano_plot_linda(linda.output, group1, 
                                taxa_table = filt_colon_uni_taxa) + 
            ggtitle(paste(group,collapse=" vs "))

volcano <- ggarrange(volcano_1)

# see the plot
volcano

MaAsLin2

volcano1 <- volcano_plot_maaslin(fit_data,filt_colon_uni_taxa) + 
            ggtitle(paste(group[1], "vs", group[2]))


volcano <- ggarrange(volcano1)

## Warning: Removed 2 rows containing missing values or values outside the scale range (`geom_text_repel()`).

volcano

Group - Intersection

intersection_results <- group_intersection(group, 
                                           list_intersections, 
                                           list_venns,
                                           linda.output, fit_data,
                                           raw_linda_results_genus, 
                                           segment = segment,
                                           level=level)

list_intersections <- intersection_results[[1]]
list_venns <- intersection_results[[2]]
venn <- intersection_results[[3]]

# show the results
venn

Basic statistics

uni_df <-  merge(basic_univariate_statistics(linda_data,group),
                 raw_linda_results_genus[[segment]][[group1]],
                 by="SeqID",all=TRUE)

## [1] "pre_ltx"
## [1] "post_ltx"
## [1] "pre_ltx"
## [1] "post_ltx"

uni_df[["final_sig"]] <- uni_df$SeqID %in% list_intersections[[paste(segment,level,comparison_name)]][["SeqID"]]
uni_statistics[[segment]][[paste(level,comparison_name)]] <- uni_df

# for comparison
new_name <- comparison_name
addWorksheet(wb, sheetName = new_name)
writeData(wb, sheet = new_name, uni_df, rowNames=FALSE)

post_ltx vs healthy

group <- c("healthy","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

linDA

# prepare the data
linda_data <- binomial_prep(colon_genus_tab,
                            colon_genus_taxa_tab,
                            colon_metadata,
                            group, usage="linDA")

## Removing 97 ASV(s)

## Removing 7 ASV(s)

filt_colon_uni_data <- linda_data[[1]]
filt_colon_uni_taxa <- linda_data[[2]]
filt_colon_uni_metadata <- linda_data[[3]]

# fit the model
linda.obj <- linda(filt_colon_uni_data,
                   filt_colon_uni_metadata,
                   formula = '~ Group + (1|Patient)')

## 0  features are filtered!
## The filtered data has  207  samples and  164  features will be tested!
## Imputation approach is used.
## Fit linear mixed effects models ...
## Completed.

linda.output <- linda.obj$output
linda.output <- linda_renaming(linda.output, group)

# save the results
group1 <- paste0(group[1], " vs ","Group",group[2])


for (grp in c(group1)){
  raw_linda_results_genus[[segment]][[grp]] <- 
    rawlinda.df(linda.output,
                grp,
                filt_colon_uni_data,
                filt_colon_uni_taxa)
  
  linda_results_genus[[segment]][[grp]] <- 
    linda.df(linda.output,
             grp,
             filt_colon_uni_data,
             filt_colon_uni_taxa)
}

# volcano plot
volcano_1 <- volcano_plot_linda(linda.output, group1, 
                                taxa_table = filt_colon_uni_taxa) + 
            ggtitle(paste(group,collapse=" vs "))

volcano <- ggarrange(volcano_1)

# see the plot
volcano

MaAsLin2

volcano1 <- volcano_plot_maaslin(fit_data,filt_colon_uni_taxa) + 
            ggtitle(paste(group[1], "vs", group[2]))

volcano <- ggarrange(volcano1)

## Warning: Removed 30 rows containing missing values or values outside the scale range (`geom_text_repel()`).

volcano

Group - Intersection

intersection_results <- group_intersection(group, list_intersections, list_venns,
                                           linda.output, fit_data,
                                           raw_linda_results_genus, 
                                           segment = segment,
                                           level=level)

list_intersections <- intersection_results[[1]]
list_venns <- intersection_results[[2]]
venn <- intersection_results[[3]]

# show the results
venn

Basic statistics

uni_df <-  merge(basic_univariate_statistics(linda_data,group),
                 raw_linda_results_genus[[segment]][[group1]],
                 by="SeqID",all=TRUE)

## [1] "healthy"
## [1] "post_ltx"
## [1] "healthy"
## [1] "post_ltx"

uni_df[["final_sig"]] <- uni_df$SeqID %in% list_intersections[[paste(segment,level,comparison_name)]][["SeqID"]]
uni_statistics[[segment]][[paste(level,comparison_name)]] <- uni_df

# for comparison
new_name <- comparison_name
addWorksheet(wb, sheetName = new_name)
writeData(wb, sheet = new_name, uni_df, rowNames=FALSE)

Visualization

Heatmap visualizing the linDA’s logFoldChange for taxa with p < 0.1.

list_heatmap <- list_intersections[grep(paste(segment,level),
                                  names(list_intersections),value=TRUE)]

p_heatmap_linda <- heatmap_linda(list_heatmap,colon_taxa_tab)

## Warning: The melt generic in data.table has been passed a data.frame and will attempt to redirect to the
## relevant reshape2 method; please note that reshape2 is superseded and is no longer actively developed, and
## this redirection is now deprecated. To continue using melt methods from reshape2 while both libraries are
## attached, e.g. melt.list, you can prepend the namespace, i.e. reshape2::melt(plot_df). In the next version,
## this warning will become an error.
## Warning: The melt generic in data.table has been passed a data.frame and will attempt to redirect to the
## relevant reshape2 method; please note that reshape2 is superseded and is no longer actively developed, and
## this redirection is now deprecated. To continue using melt methods from reshape2 while both libraries are
## attached, e.g. melt.list, you can prepend the namespace, i.e. reshape2::melt(plot_df). In the next version,
## this warning will become an error.

## Warning: The dcast generic in data.table has been passed a data.frame and will attempt to redirect to the
## relevant reshape2 method; please note that reshape2 is superseded and is no longer actively developed, and
## this redirection is now deprecated. Please do this redirection yourself like
## reshape2::dcast(plot_df_combined). In the next version, this warning will become an error.

p_heatmap_linda

Dot heatmap

dotheatmap_linda <- dot_heatmap_linda(list_heatmap,
                                      uni_df,
                                      colon_taxa_tab)

## Warning: The melt generic in data.table has been passed a data.frame and will attempt to redirect to the
## relevant reshape2 method; please note that reshape2 is superseded and is no longer actively developed, and
## this redirection is now deprecated. To continue using melt methods from reshape2 while both libraries are
## attached, e.g. melt.list, you can prepend the namespace, i.e. reshape2::melt(plot_df). In the next version,
## this warning will become an error.
## Warning: The melt generic in data.table has been passed a data.frame and will attempt to redirect to the
## relevant reshape2 method; please note that reshape2 is superseded and is no longer actively developed, and
## this redirection is now deprecated. To continue using melt methods from reshape2 while both libraries are
## attached, e.g. melt.list, you can prepend the namespace, i.e. reshape2::melt(plot_df). In the next version,
## this warning will become an error.
## Warning: The melt generic in data.table has been passed a data.frame and will attempt to redirect to the
## relevant reshape2 method; please note that reshape2 is superseded and is no longer actively developed, and
## this redirection is now deprecated. To continue using melt methods from reshape2 while both libraries are
## attached, e.g. melt.list, you can prepend the namespace, i.e. reshape2::melt(plot_df). In the next version,
## this warning will become an error.

## min_clr -2.032531 
## max_clr 4.8669 
## min_log -3.589517 
## max_log 3.817599

dotheatmap_linda

PSC effect

pre_LTx vs Healthy and Post_LTx vs Healthy intersection

imagename

A <- list_intersections[[paste(segment,level,"healthy vs pre_ltx")]]$SeqID
B <- list_intersections[[paste(segment,level,"healthy vs post_ltx")]]$SeqID
C <- intersect(A,B)

psc_effect[[paste(segment,level)]] <- list_intersections[[paste(segment,level, "healthy vs pre_ltx")]][list_intersections[[paste(segment,level, "healthy vs pre_ltx")]]$SeqID %in% C,]
  
# see the results
psc_effect[[paste(segment,level)]] 

Saving results

# ALL DATA
saveWorkbook(wb,file.path(path,paste0("uni_analysis_wb_",segment,".xlsx")),
             overwrite = TRUE)

# PSC effect
write.xlsx(psc_effect[[paste(segment,level)]],file.path(path,paste0("psc_effect_",segment,".xlsx")))

# SIGNIFICANT taxa

write.xlsx(list_intersections[grepl(segment,names(list_intersections))] %>%
            `names<-`(gsub(segment, "", names(
              list_intersections[grepl(segment,names(list_intersections))]))),
           file.path(path,paste0("significant_taxa_",segment,".xlsx")))

Supplementary Analysis

ASV level

level="ASV"

path_maaslin="../intermediate_files/maaslin/Q1_norway/ASV/"

raw_linda_results[[segment]] <- list()
linda_results[[segment]] <- list()
supplements_wb <- createWorkbook()

pre_ltx vs healthy

group <- c("healthy","pre_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

linDA

# prepare the data
linda_data <- binomial_prep(colon_asv_tab,
                            colon_taxa_tab,
                            colon_metadata,
                            group, usage="linDA")

## Removing 900 ASV(s)

## Removing 78 ASV(s)

filt_colon_uni_data <- linda_data[[1]]
filt_colon_uni_taxa <- linda_data[[2]]
filt_colon_uni_metadata <- linda_data[[3]]

# fit the model
linda.obj <- linda(filt_colon_uni_data, 
                   filt_colon_uni_metadata, 
                   formula = '~ Group + (1|Patient)',prev.filter = 0.2)

## 339  features are filtered!
## The filtered data has  273  samples and  174  features will be tested!
## Pseudo-count approach is used.
## Fit linear mixed effects models ...
## Completed.

linda.output <- linda.obj$output
linda.output <- linda_renaming(linda.output, group)

group1 <- paste0(group[1], " vs ","Group",group[2])

for (grp in c(group1)){
  raw_linda_results[[segment]][[grp]] <- 
    rawlinda.df(linda.output,
                grp,
                filt_colon_uni_data,
                filt_colon_uni_taxa)
  
  linda_results[[segment]][[grp]] <- 
    linda.df(linda.output,
             grp,
             filt_colon_uni_data,
             filt_colon_uni_taxa)
}

# volcano plot
volcano_1 <- volcano_plot_linda(linda.output, group1,
                                taxa_table = filt_colon_uni_taxa) +
              ggtitle(paste(group,collapse=" vs "))


volcano <- ggarrange(volcano_1)

# see the plot
volcano

MaAsLin2

Volcano plot

volcano1 <- volcano_plot_maaslin(fit_data,filt_colon_uni_taxa) + 
            ggtitle(paste(group[1], "vs", group[2]))

volcano <- ggarrange(volcano1)

# see the results
volcano

## Warning: ggrepel: 120 unlabeled data points (too many overlaps). Consider increasing max.overlaps

Group - Intersection

intersection_results <- group_intersection(group, list_intersections, list_venns,
                                           linda.output, fit_data,
                                           raw_linda_results, 
                                                                                      segment = segment,
                                           level=level)

list_intersections <- intersection_results[[1]]
list_venns <- intersection_results[[2]]
venn <- intersection_results[[3]]

# show the results
venn

Basic statistics

uni_df <-  merge(basic_univariate_statistics(linda_data,group),
                 raw_linda_results[[segment]][[group1]],
                 by="SeqID",all=TRUE)

## [1] "healthy"
## [1] "pre_ltx"
## [1] "healthy"
## [1] "pre_ltx"

uni_df[["final_sig"]] <- uni_df$SeqID %in% list_intersections[[paste(segment,level,comparison_name)]][["SeqID"]]
uni_statistics[[segment]][[paste(level,comparison_name)]] <- uni_df

# for comparison
new_name <- paste(level,comparison_name)
addWorksheet(supplements_wb, sheetName = new_name)
writeData(supplements_wb, sheet = new_name, uni_df, rowNames=FALSE)

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

linDA

# prepare the data
linda_data <- binomial_prep(colon_asv_tab,
                            colon_taxa_tab,
                            colon_metadata,
                            group, usage="linDA")

## Removing 848 ASV(s)

## Removing 45 ASV(s)

filt_colon_uni_data <- linda_data[[1]]
filt_colon_uni_taxa <- linda_data[[2]]
filt_colon_uni_metadata <- linda_data[[3]]

# fit the model
linda.obj <- linda(filt_colon_uni_data, 
                   filt_colon_uni_metadata, 
                   formula = '~ Group + (1|Patient)')

## 0  features are filtered!
## The filtered data has  349  samples and  304  features will be tested!
## Pseudo-count approach is used.
## Fit linear mixed effects models ...
## Completed.

linda.output <- linda.obj$output
linda.output <- linda_renaming(linda.output, group)

group1 <- paste0(group[1], " vs ","Group",group[2])

for (grp in c(group1)){
  raw_linda_results[[segment]][[grp]] <- 
    rawlinda.df(linda.output,
                grp,
                filt_colon_uni_data,
                filt_colon_uni_taxa)
  
  linda_results[[segment]][[grp]] <- 
    linda.df(linda.output,
             grp,
             filt_colon_uni_data,
             filt_colon_uni_taxa)
}

# volcano plot
volcano_1 <- volcano_plot_linda(linda.output, group1,
                                taxa_table = filt_colon_uni_taxa) +
              ggtitle(paste(group,collapse=" vs "))

volcano <- ggarrange(volcano_1)

# see the plot
volcano

MaAsLin2

volcano1 <- volcano_plot_maaslin(fit_data,filt_colon_uni_taxa) + 
            ggtitle(paste(group[1], "vs", group[2]))

volcano <- ggarrange(volcano1)

# see the results
volcano

Group - Intersection

intersection_results <- group_intersection(group, list_intersections, list_venns,
                                           linda.output, fit_data,
                                           raw_linda_results, 
                                           segment=segment,
                                           level=level)

list_intersections <- intersection_results[[1]]
list_venns <- intersection_results[[2]]
venn <- intersection_results[[3]]

# show the results
venn

Basic statistics

uni_df <-  merge(basic_univariate_statistics(linda_data,group),
                 raw_linda_results[[segment]][[group1]],
                 by="SeqID",all=TRUE)

## [1] "pre_ltx"
## [1] "post_ltx"
## [1] "pre_ltx"
## [1] "post_ltx"

uni_df[["final_sig"]] <- uni_df$SeqID %in% list_intersections[[paste(segment,level,comparison_name)]][["SeqID"]]
uni_statistics[[segment]][[paste(level,comparison_name)]] <- uni_df

# for comparison
new_name <- paste(level,comparison_name)
addWorksheet(supplements_wb, sheetName = new_name)
writeData(supplements_wb, sheet = new_name, uni_df, rowNames=FALSE)

post_ltx vs healthy

group <- c("healthy","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

linDA

# prepare the data
linda_data <- binomial_prep(colon_asv_tab,
                            colon_taxa_tab,
                            colon_metadata,
                            group, usage="linDA")

## Removing 1180 ASV(s)

## Removing 72 ASV(s)

filt_colon_uni_data <- linda_data[[1]]
filt_colon_uni_taxa <- linda_data[[2]]
filt_colon_uni_metadata <- linda_data[[3]]

# fit the model
linda.obj <- linda(filt_colon_uni_data, 
                   filt_colon_uni_metadata, 
                   formula = '~ Group + (1|Patient)')

## 0  features are filtered!
## The filtered data has  207  samples and  528  features will be tested!
## Imputation approach is used.
## Fit linear mixed effects models ...
## Completed.

linda.output <- linda.obj$output
linda.output <- linda_renaming(linda.output, group)

group1 <- paste0(group[1], " vs ","Group",group[2])

for (grp in c(group1)){
  raw_linda_results[[segment]][[grp]] <- 
    rawlinda.df(linda.output,
                grp,
                filt_colon_uni_data,
                filt_colon_uni_taxa)
  
  linda_results[[segment]][[grp]] <- 
    linda.df(linda.output,
             grp,
             filt_colon_uni_data,
             filt_colon_uni_taxa)
}

# volcano plot
volcano_1 <- volcano_plot_linda(linda.output, group1,
                                taxa_table = filt_colon_uni_taxa) +
              ggtitle(paste(group,collapse=" vs "))


volcano <- ggarrange(volcano_1)

# see the plot
volcano

## Warning: ggrepel: 14 unlabeled data points (too many overlaps). Consider increasing max.overlaps

MaAsLin2

volcano1 <- volcano_plot_maaslin(fit_data,filt_colon_uni_taxa) + 
            ggtitle(paste(group[1], "vs", group[2]))

volcano <- ggarrange(volcano1)
volcano

## Warning: ggrepel: 61 unlabeled data points (too many overlaps). Consider increasing max.overlaps

Group - Intersection

intersection_results <- group_intersection(group, list_intersections, list_venns,
                                           linda.output, fit_data,
                                           raw_linda_results, 
                                           segment = segment,
                                           level=level)

list_intersections <- intersection_results[[1]]
list_venns <- intersection_results[[2]]
venn <- intersection_results[[3]]

# show the results
venn

Basic statistics

uni_df <-  merge(basic_univariate_statistics(linda_data,group),
                 raw_linda_results[[segment]][[group1]],
                 by="SeqID",all=TRUE)

## [1] "healthy"
## [1] "post_ltx"
## [1] "healthy"
## [1] "post_ltx"

uni_df[["final_sig"]] <- uni_df$SeqID %in% list_intersections[[paste(segment,level,comparison_name)]][["SeqID"]]
uni_statistics[[segment]][[paste(level,comparison_name)]] <- uni_df

# for comparison
new_name <- paste(level,comparison_name)
addWorksheet(supplements_wb, sheetName = new_name)
writeData(supplements_wb, sheet = new_name, uni_df, rowNames=FALSE)

Visualization

Heatmap visualizing the linDA’s logFoldChange for taxa with p < 0.1.

list_heatmap <- list_intersections[grep(paste(segment,level),
                                  names(list_intersections),value=TRUE)]

p_heatmap_linda <- heatmap_linda(list_heatmap,colon_taxa_tab)

## Warning: The melt generic in data.table has been passed a data.frame and will attempt to redirect to the
## relevant reshape2 method; please note that reshape2 is superseded and is no longer actively developed, and
## this redirection is now deprecated. To continue using melt methods from reshape2 while both libraries are
## attached, e.g. melt.list, you can prepend the namespace, i.e. reshape2::melt(plot_df). In the next version,
## this warning will become an error.
## Warning: The melt generic in data.table has been passed a data.frame and will attempt to redirect to the
## relevant reshape2 method; please note that reshape2 is superseded and is no longer actively developed, and
## this redirection is now deprecated. To continue using melt methods from reshape2 while both libraries are
## attached, e.g. melt.list, you can prepend the namespace, i.e. reshape2::melt(plot_df). In the next version,
## this warning will become an error.

## Warning: The dcast generic in data.table has been passed a data.frame and will attempt to redirect to the
## relevant reshape2 method; please note that reshape2 is superseded and is no longer actively developed, and
## this redirection is now deprecated. Please do this redirection yourself like
## reshape2::dcast(plot_df_combined). In the next version, this warning will become an error.

p_heatmap_linda

Dot heatmap

dotheatmap_linda <- dot_heatmap_linda(list_heatmap,uni_df,colon_taxa_tab)

## Warning: The melt generic in data.table has been passed a data.frame and will attempt to redirect to the
## relevant reshape2 method; please note that reshape2 is superseded and is no longer actively developed, and
## this redirection is now deprecated. To continue using melt methods from reshape2 while both libraries are
## attached, e.g. melt.list, you can prepend the namespace, i.e. reshape2::melt(plot_df). In the next version,
## this warning will become an error.
## Warning: The melt generic in data.table has been passed a data.frame and will attempt to redirect to the
## relevant reshape2 method; please note that reshape2 is superseded and is no longer actively developed, and
## this redirection is now deprecated. To continue using melt methods from reshape2 while both libraries are
## attached, e.g. melt.list, you can prepend the namespace, i.e. reshape2::melt(plot_df). In the next version,
## this warning will become an error.
## Warning: The melt generic in data.table has been passed a data.frame and will attempt to redirect to the
## relevant reshape2 method; please note that reshape2 is superseded and is no longer actively developed, and
## this redirection is now deprecated. To continue using melt methods from reshape2 while both libraries are
## attached, e.g. melt.list, you can prepend the namespace, i.e. reshape2::melt(plot_df). In the next version,
## this warning will become an error.

## min_clr -0.9486582 
## max_clr 6.236875 
## min_log -4.029266 
## max_log 3.847596

dotheatmap_linda

PSC effect

pre_LTx vs Healthy and Post_LTx vs Healthy intersection

imagename

A <- list_intersections[[paste(segment,level,"healthy vs pre_ltx")]]$SeqID
B <- list_intersections[[paste(segment,level,"healthy vs post_ltx")]]$SeqID
C <- intersect(A,B)

psc_effect[[paste(segment,level)]] <- list_intersections[[paste(segment,level, "healthy vs pre_ltx")]][list_intersections[[paste(segment,level, "healthy vs pre_ltx")]]$SeqID %in% C,]
  
# see the results
psc_effect[[paste(segment,level)]] 

Phylum level

level="phylum"

path_maaslin="../intermediate_files/maaslin/Q1_norway/Phylum/"

raw_linda_results_phylum[[segment]] <- list()
linda_results_phylum[[segment]] <- list()

Aggregate taxa

phylum_data <- aggregate_taxa(colon_asv_tab,
                             colon_taxa_tab,
                             taxonomic_level = "Phylum")

colon_phylum_tab <- phylum_data[[1]]
colon_phylum_taxa_tab <- phylum_data[[2]]

pre_ltx vs healthy

group <- c("healthy","pre_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

linDA

# prepare the data
linda_data <- binomial_prep(colon_phylum_tab,
                            colon_phylum_taxa_tab,
                            colon_metadata,
                            group, usage="linDA")

## Removing 1 ASV(s)

filt_colon_uni_data <- linda_data[[1]]
filt_colon_uni_taxa <- linda_data[[2]]
filt_colon_uni_metadata <- linda_data[[3]]

# fit the model
linda.obj <- linda(filt_colon_uni_data, 
                   filt_colon_uni_metadata, 
                   formula = '~ Group + (1|Patient)')

## 0  features are filtered!
## The filtered data has  274  samples and  8  features will be tested!
## Imputation approach is used.
## Fit linear mixed effects models ...
## Completed.

linda.output <- linda.obj$output
linda.output <- linda_renaming(linda.output, group)

group1 <- paste0(group[1], " vs ","Group",group[2])

for (grp in c(group1)){
  raw_linda_results[[segment]][[grp]] <- 
    rawlinda.df(linda.output,
                grp,
                filt_colon_uni_data,
                filt_colon_uni_taxa)
  
  linda_results[[segment]][[grp]] <- 
    linda.df(linda.output,
             grp,
             filt_colon_uni_data,
             filt_colon_uni_taxa)
}

# volcano plot
volcano_1 <- volcano_plot_linda(linda.output, group1,
                                taxa_table = filt_colon_uni_taxa) +
              ggtitle(paste(group,collapse=" vs "))

## Using Phylum for naming

volcano <- ggarrange(volcano_1)

# see the plot
volcano

MaAsLin2

Volcano plot

volcano1 <- volcano_plot_maaslin(fit_data,filt_colon_uni_taxa) + 
            ggtitle(paste(group[1], "vs", group[2]))

volcano <- ggarrange(volcano1)

# see the results
volcano

Group - Intersection

intersection_results <- group_intersection(group, list_intersections, list_venns,
                                           linda.output, fit_data,
                                           raw_linda_results, 
                                                                                      segment = segment,
                                           level=level)

list_intersections <- intersection_results[[1]]
list_venns <- intersection_results[[2]]
venn <- intersection_results[[3]]

# show the results
venn

Basic statistics

uni_df <-  merge(basic_univariate_statistics(linda_data,group),
                 raw_linda_results[[segment]][[group1]],
                 by="SeqID",all=TRUE)

## [1] "healthy"
## [1] "pre_ltx"
## [1] "healthy"
## [1] "pre_ltx"

uni_df[["final_sig"]] <- uni_df$SeqID %in% list_intersections[[paste(segment,level,comparison_name)]][["SeqID"]]
uni_statistics[[segment]][[paste(level,comparison_name)]] <- uni_df

# for comparison
new_name <- paste(level,comparison_name)
addWorksheet(supplements_wb, sheetName = new_name)
writeData(supplements_wb, sheet = new_name, uni_df, rowNames=FALSE)

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

linDA

# prepare the data
linda_data <- binomial_prep(colon_phylum_tab,
                            colon_phylum_taxa_tab,
                            colon_metadata,
                            group, usage="linDA")

## Removing 1 ASV(s)
## Removing 1 ASV(s)

filt_colon_uni_data <- linda_data[[1]]
filt_colon_uni_taxa <- linda_data[[2]]
filt_colon_uni_metadata <- linda_data[[3]]

# fit the model
linda.obj <- linda(filt_colon_uni_data, 
                   filt_colon_uni_metadata, 
                   formula = '~ Group + (1|Patient)')

## 0  features are filtered!
## The filtered data has  349  samples and  8  features will be tested!
## Pseudo-count approach is used.
## Fit linear mixed effects models ...
## Completed.

linda.output <- linda.obj$output
linda.output <- linda_renaming(linda.output, group)

group1 <- paste0(group[1], " vs ","Group",group[2])

for (grp in c(group1)){
  raw_linda_results[[segment]][[grp]] <- 
    rawlinda.df(linda.output,
                grp,
                filt_colon_uni_data,
                filt_colon_uni_taxa)
  
  linda_results[[segment]][[grp]] <- 
    linda.df(linda.output,
             grp,
             filt_colon_uni_data,
             filt_colon_uni_taxa)
}

# volcano plot
volcano_1 <- volcano_plot_linda(linda.output, group1,
                                taxa_table = filt_colon_uni_taxa) +
              ggtitle(paste(group,collapse=" vs "))

## Using Phylum for naming

volcano <- ggarrange(volcano_1)

# see the plot
volcano

MaAsLin2

volcano1 <- volcano_plot_maaslin(fit_data,filt_colon_uni_taxa) + 
            ggtitle(paste(group[1], "vs", group[2]))

volcano <- ggarrange(volcano1)

# see the results
volcano

Group - Intersection

intersection_results <- group_intersection(group, list_intersections, list_venns,
                                           linda.output, fit_data,
                                           raw_linda_results, 
                                           segment=segment,
                                           level=level)

list_intersections <- intersection_results[[1]]
list_venns <- intersection_results[[2]]
venn <- intersection_results[[3]]

# show the results
venn

Basic statistics

uni_df <-  merge(basic_univariate_statistics(linda_data,group),
                 raw_linda_results[[segment]][[group1]],
                 by="SeqID",all=TRUE)

## [1] "pre_ltx"
## [1] "post_ltx"
## [1] "pre_ltx"
## [1] "post_ltx"

uni_df[["final_sig"]] <- uni_df$SeqID %in% list_intersections[[paste(segment,level,comparison_name)]][["SeqID"]]
uni_statistics[[segment]][[paste(level,comparison_name)]] <- uni_df

# for comparison
new_name <- paste(level,comparison_name)
addWorksheet(supplements_wb, sheetName = new_name)
writeData(supplements_wb, sheet = new_name, uni_df, rowNames=FALSE)

post_ltx vs healthy

group <- c("healthy","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

linDA

# prepare the data
linda_data <- binomial_prep(colon_phylum_tab,
                            colon_phylum_taxa_tab,
                            colon_metadata,
                            group, usage="linDA")

## Removing 6 ASV(s)

filt_colon_uni_data <- linda_data[[1]]
filt_colon_uni_taxa <- linda_data[[2]]
filt_colon_uni_metadata <- linda_data[[3]]

# fit the model
linda.obj <- linda(filt_colon_uni_data, 
                   filt_colon_uni_metadata, 
                   formula = '~ Group + (1|Patient)')

## 0  features are filtered!
## The filtered data has  207  samples and  8  features will be tested!
## Imputation approach is used.
## Fit linear mixed effects models ...
## Completed.

linda.output <- linda.obj$output
linda.output <- linda_renaming(linda.output, group)

group1 <- paste0(group[1], " vs ","Group",group[2])

for (grp in c(group1)){
  raw_linda_results[[segment]][[grp]] <- 
    rawlinda.df(linda.output,
                grp,
                filt_colon_uni_data,
                filt_colon_uni_taxa)
  
  linda_results[[segment]][[grp]] <- 
    linda.df(linda.output,
             grp,
             filt_colon_uni_data,
             filt_colon_uni_taxa)
}

# volcano plot
volcano_1 <- volcano_plot_linda(linda.output, group1,
                                taxa_table = filt_colon_uni_taxa) +
              ggtitle(paste(group,collapse=" vs "))

## Using Phylum for naming

volcano <- ggarrange(volcano_1)

# see the plot
volcano

MaAsLin2

volcano1 <- volcano_plot_maaslin(fit_data,filt_colon_uni_taxa) + 
            ggtitle(paste(group[1], "vs", group[2]))


volcano <- ggarrange(volcano1)
volcano

Group - Intersection

intersection_results <- group_intersection(group, list_intersections, list_venns,
                                           linda.output, fit_data,
                                           raw_linda_results, 
                                           segment = segment,
                                           level=level)

list_intersections <- intersection_results[[1]]
list_venns <- intersection_results[[2]]
venn <- intersection_results[[3]]

# show the results
venn

Basic statistics

uni_df <-  merge(basic_univariate_statistics(linda_data,group),
                 raw_linda_results[[segment]][[group1]],
                 by="SeqID",all=TRUE)

## [1] "healthy"
## [1] "post_ltx"
## [1] "healthy"
## [1] "post_ltx"

uni_df[["final_sig"]] <- uni_df$SeqID %in% list_intersections[[paste(segment,level,comparison_name)]][["SeqID"]]
uni_statistics[[segment]][[paste(level,comparison_name)]] <- uni_df

# for comparison
new_name <- paste(level,comparison_name)
addWorksheet(supplements_wb, sheetName = new_name)
writeData(supplements_wb, sheet = new_name, uni_df, rowNames=FALSE)

Visualization

Heatmap visualizing the linDA’s logFoldChange for taxa with p < 0.1.

list_heatmap <- list_intersections[grep(paste(segment,level),
                                  names(list_intersections),value=TRUE)]

p_heatmap_linda <- heatmap_linda(list_heatmap,colon_taxa_tab)

## Warning: The melt generic in data.table has been passed a data.frame and will attempt to redirect to the
## relevant reshape2 method; please note that reshape2 is superseded and is no longer actively developed, and
## this redirection is now deprecated. To continue using melt methods from reshape2 while both libraries are
## attached, e.g. melt.list, you can prepend the namespace, i.e. reshape2::melt(plot_df). In the next version,
## this warning will become an error.
## Warning: The melt generic in data.table has been passed a data.frame and will attempt to redirect to the
## relevant reshape2 method; please note that reshape2 is superseded and is no longer actively developed, and
## this redirection is now deprecated. To continue using melt methods from reshape2 while both libraries are
## attached, e.g. melt.list, you can prepend the namespace, i.e. reshape2::melt(plot_df). In the next version,
## this warning will become an error.

## Warning: The dcast generic in data.table has been passed a data.frame and will attempt to redirect to the
## relevant reshape2 method; please note that reshape2 is superseded and is no longer actively developed, and
## this redirection is now deprecated. Please do this redirection yourself like
## reshape2::dcast(plot_df_combined). In the next version, this warning will become an error.

p_heatmap_linda

Dot heatmap

dotheatmap_linda <- dot_heatmap_linda(list_heatmap,uni_df,colon_taxa_tab)

## Warning: The melt generic in data.table has been passed a data.frame and will attempt to redirect to the
## relevant reshape2 method; please note that reshape2 is superseded and is no longer actively developed, and
## this redirection is now deprecated. To continue using melt methods from reshape2 while both libraries are
## attached, e.g. melt.list, you can prepend the namespace, i.e. reshape2::melt(plot_df). In the next version,
## this warning will become an error.
## Warning: The melt generic in data.table has been passed a data.frame and will attempt to redirect to the
## relevant reshape2 method; please note that reshape2 is superseded and is no longer actively developed, and
## this redirection is now deprecated. To continue using melt methods from reshape2 while both libraries are
## attached, e.g. melt.list, you can prepend the namespace, i.e. reshape2::melt(plot_df). In the next version,
## this warning will become an error.
## Warning: The melt generic in data.table has been passed a data.frame and will attempt to redirect to the
## relevant reshape2 method; please note that reshape2 is superseded and is no longer actively developed, and
## this redirection is now deprecated. To continue using melt methods from reshape2 while both libraries are
## attached, e.g. melt.list, you can prepend the namespace, i.e. reshape2::melt(plot_df). In the next version,
## this warning will become an error.

## min_clr -4.405553 
## max_clr 2.814299 
## min_log -3.206076 
## max_log 1.761042

dotheatmap_linda

PSC effect

pre_LTx vs Healthy and Post_LTx vs Healthy intersection

imagename

A <- list_intersections[[paste(segment,level,"healthy vs pre_ltx")]]$SeqID
B <- list_intersections[[paste(segment,level,"healthy vs post_ltx")]]$SeqID
C <- intersect(A,B)

psc_effect[[paste(segment,level)]] <- list_intersections[[paste(segment,level, "healthy vs pre_ltx")]][list_intersections[[paste(segment,level, "healthy vs pre_ltx")]]$SeqID %in% C,]
  
# see the results
psc_effect[[paste(segment,level)]] 

Machine learning

path = "../results/Q1_norway/models"

ElasticNet

model="enet"

ASV level

level="ASV"

pre_ltx vs healthy

group <- c("pre_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_asv_tab,
                                     colon_taxa_tab,
                                     colon_metadata,
                                     group, 
                                     usage="ml_clr",
                                     patient = TRUE)

## Removing 900 ASV(s)

## Removing 78 ASV(s)

# fit the model
enet_model <- glmnet_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC
roc_c <- roc_curve(enet_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

models_summ[[model_name]] <- enet_model$model_summary
models_cm[[model_name]] <- enet_model$conf_matrices$original
roc_cs[[model_name]] <- enet_model$kfold_rocobjs
betas[[model_name]] <- as.matrix(enet_model$betas)

# see the results
enet_model$model_summary %>% t()

##                                        [,1]
## alpha                           0.600000000
## lambda                          0.006418715
## auc                             1.000000000
## auc_czech                               NaN
## auc_no                          1.000000000
## auc_optimism_corrected          0.899803944
## auc_optimism_corrected_CIL      0.862554452
## auc_optimism_corrected_CIU      0.954837040
## accuracy                        1.000000000
## accuracy_czech                          NaN
## accuracy_no                     1.000000000
## accuracy_optimism_corrected     0.854825924
## accuracy_optimism_corrected_CIL 0.763185352
## accuracy_optimism_corrected_CIU 0.909881423

enet_model$conf_matrices

## $original
##     Predicted
## True   0   1
##    0  66   0
##    1   0 208
## 
## $czech
## [1] NaN
## 
## $no
##     Predicted
## True   0   1
##    0  66   0
##    1   0 208

enet_model$plot

## `geom_smooth()` using formula = 'y ~ x'

## `geom_smooth()` using formula = 'y ~ x'

roc_c

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_asv_tab,
                                     colon_taxa_tab,
                                     colon_metadata,
                                     group, usage="ml_clr",
                                     patient = TRUE)

## Removing 848 ASV(s)

## Removing 45 ASV(s)

# fit the model
enet_model <- glmnet_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", N=10,
                              clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC
roc_c <- roc_curve(enet_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
models_summ[[model_name]] <- enet_model$model_summary
models_cm[[model_name]] <- enet_model$conf_matrices$original
roc_cs[[model_name]] <- enet_model$kfold_rocobjs
betas[[model_name]] <- as.matrix(enet_model$betas)

# see the results
enet_model$model_summary %>% t()

##                                        [,1]
## alpha                           0.400000000
## lambda                          0.002321497
## auc                             1.000000000
## auc_czech                               NaN
## auc_no                          1.000000000
## auc_optimism_corrected          0.776893742
## auc_optimism_corrected_CIL      0.722118098
## auc_optimism_corrected_CIU      0.835243907
## accuracy                        1.000000000
## accuracy_czech                          NaN
## accuracy_no                     1.000000000
## accuracy_optimism_corrected     0.720985227
## accuracy_optimism_corrected_CIL 0.675597312
## accuracy_optimism_corrected_CIU 0.782035468

enet_model$conf_matrices

## $original
##     Predicted
## True   0   1
##    0 141   0
##    1   0 208
## 
## $czech
## [1] NaN
## 
## $no
##     Predicted
## True   0   1
##    0 141   0
##    1   0 208

enet_model$plot

## `geom_smooth()` using formula = 'y ~ x'

## `geom_smooth()` using formula = 'y ~ x'

roc_c

post_ltx vs healthy

group <- c("post_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_asv_tab,
                                     colon_taxa_tab,
                                     colon_metadata,
                                     group, 
                                     usage="ml_clr",
                                     patient = TRUE)

## Removing 1180 ASV(s)

## Removing 72 ASV(s)

# fit the model
enet_model <- glmnet_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC
roc_c <- roc_curve(enet_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
models_summ[[model_name]] <- enet_model$model_summary
models_cm[[model_name]] <- enet_model$conf_matrices$original
roc_cs[[model_name]] <- enet_model$kfold_rocobjs
betas[[model_name]] <- as.matrix(enet_model$betas)

# see the results
enet_model$model_summary %>% t()

##                                        [,1]
## alpha                           0.400000000
## lambda                          0.009181833
## auc                             1.000000000
## auc_czech                               NaN
## auc_no                          1.000000000
## auc_optimism_corrected          0.912892293
## auc_optimism_corrected_CIL      0.726281375
## auc_optimism_corrected_CIU      0.996938776
## accuracy                        1.000000000
## accuracy_czech                          NaN
## accuracy_no                     1.000000000
## accuracy_optimism_corrected     0.865169592
## accuracy_optimism_corrected_CIL 0.665824049
## accuracy_optimism_corrected_CIU 0.985714286

enet_model$conf_matrices

## $original
##     Predicted
## True   0   1
##    0  66   0
##    1   0 141
## 
## $czech
## [1] NaN
## 
## $no
##     Predicted
## True   0   1
##    0  66   0
##    1   0 141

enet_model$plot

## `geom_smooth()` using formula = 'y ~ x'

## `geom_smooth()` using formula = 'y ~ x'

roc_c

Genus level

level="genus"

Aggregate taxa

genus_data <- aggregate_taxa(colon_asv_tab,
                             colon_taxa_tab,
                             taxonomic_level = level)

colon_genus_tab <- genus_data[[1]]
colon_genus_taxa_tab <- genus_data[[2]]

pre_ltx vs healthy

group <- c("pre_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_genus_tab,
                                     colon_genus_taxa_tab,
                                     colon_metadata,
                                     group, 
                                     usage="ml_clr",
                                     patient = TRUE)

## Removing 54 ASV(s)

## Removing 11 ASV(s)

# fit the model
enet_model <- glmnet_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC
roc_c <- roc_curve(enet_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
models_summ[[model_name]] <- enet_model$model_summary
models_cm[[model_name]] <- enet_model$conf_matrices$original
roc_cs[[model_name]] <- enet_model$kfold_rocobjs
betas[[model_name]] <- as.matrix(enet_model$betas)

# see the results
enet_model$model_summary %>% t()

##                                        [,1]
## alpha                           1.000000000
## lambda                          0.002002496
## auc                             1.000000000
## auc_czech                               NaN
## auc_no                          1.000000000
## auc_optimism_corrected          0.939129742
## auc_optimism_corrected_CIL      0.873705846
## auc_optimism_corrected_CIU      0.972359287
## accuracy                        1.000000000
## accuracy_czech                          NaN
## accuracy_no                     1.000000000
## accuracy_optimism_corrected     0.897874319
## accuracy_optimism_corrected_CIL 0.822478098
## accuracy_optimism_corrected_CIU 0.941397825

enet_model$conf_matrices

## $original
##     Predicted
## True   0   1
##    0  66   0
##    1   0 208
## 
## $czech
## [1] NaN
## 
## $no
##     Predicted
## True   0   1
##    0  66   0
##    1   0 208

enet_model$plot

## `geom_smooth()` using formula = 'y ~ x'

## `geom_smooth()` using formula = 'y ~ x'

roc_c

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_genus_tab,
                                     colon_genus_taxa_tab,
                                     colon_metadata,
                                     group, 
                                     usage="ml_clr",
                                     patient = TRUE)

## Removing 18 ASV(s)

## Removing 13 ASV(s)

# fit the model
enet_model <- glmnet_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC
roc_c <- roc_curve(enet_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
models_summ[[model_name]] <- enet_model$model_summary
models_cm[[model_name]] <- enet_model$conf_matrices$original
roc_cs[[model_name]] <- enet_model$kfold_rocobjs
betas[[model_name]] <- as.matrix(enet_model$betas)

# see the results
enet_model$model_summary %>% t()

##                                        [,1]
## alpha                           0.400000000
## lambda                          0.004668847
## auc                             1.000000000
## auc_czech                               NaN
## auc_no                          1.000000000
## auc_optimism_corrected          0.719529792
## auc_optimism_corrected_CIL      0.610100571
## auc_optimism_corrected_CIU      0.811366490
## accuracy                        1.000000000
## accuracy_czech                          NaN
## accuracy_no                     1.000000000
## accuracy_optimism_corrected     0.672240876
## accuracy_optimism_corrected_CIL 0.559724912
## accuracy_optimism_corrected_CIU 0.777542460

enet_model$conf_matrices

## $original
##     Predicted
## True   0   1
##    0 141   0
##    1   0 208
## 
## $czech
## [1] NaN
## 
## $no
##     Predicted
## True   0   1
##    0 141   0
##    1   0 208

enet_model$plot

## `geom_smooth()` using formula = 'y ~ x'

## `geom_smooth()` using formula = 'y ~ x'

roc_c

post_ltx vs healthy

group <- c("post_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_genus_tab,
                                     colon_genus_taxa_tab,
                                     colon_metadata,
                                     group, 
                                     usage="ml_clr",
                                     patient = TRUE)

## Removing 97 ASV(s)

## Removing 7 ASV(s)

# fit the model
enet_model <- glmnet_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group",
                              N=10,
                              clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC
roc_c <- roc_curve(enet_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
models_summ[[model_name]] <- enet_model$model_summary
models_cm[[model_name]] <- enet_model$conf_matrices$original
roc_cs[[model_name]] <- enet_model$kfold_rocobjs
betas[[model_name]] <- as.matrix(enet_model$betas)

# see the results
enet_model$model_summary %>% t()

##                                         [,1]
## alpha                           0.2000000000
## lambda                          0.0005131181
## auc                             1.0000000000
## auc_czech                                NaN
## auc_no                          1.0000000000
## auc_optimism_corrected          0.9437453910
## auc_optimism_corrected_CIL      0.8534746657
## auc_optimism_corrected_CIU      0.9922908724
## accuracy                        1.0000000000
## accuracy_czech                           NaN
## accuracy_no                     1.0000000000
## accuracy_optimism_corrected     0.8783399977
## accuracy_optimism_corrected_CIL 0.7556653353
## accuracy_optimism_corrected_CIU 0.9366636528

enet_model$conf_matrices

## $original
##     Predicted
## True   0   1
##    0  66   0
##    1   0 141
## 
## $czech
## [1] NaN
## 
## $no
##     Predicted
## True   0   1
##    0  66   0
##    1   0 141

enet_model$plot

## `geom_smooth()` using formula = 'y ~ x'

## `geom_smooth()` using formula = 'y ~ x'

roc_c

Saving results

models_summ_df_colon <- do.call(rbind, 
  models_summ[grep(segment,names(models_summ),value = TRUE)])

write.csv(models_summ_df_colon,file.path(path,paste0("elastic_net_",segment,".csv")))

Supplementary models

CLR-transformed data

kNN

model="knn"

ASV level

level="ASV"

pre_ltx vs healthy

group <- c("pre_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_asv_tab,
                                     colon_taxa_tab,
                                     colon_metadata,
                                     group, usage="ml_clr",
                                     patient = TRUE)

## Removing 900 ASV(s)

## Removing 78 ASV(s)

# fit the model
knn_model <- knn_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(knn_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["knn_model"]][[model_name]] <- knn_model$model_summary
supplements_models[["roc_cs"]][["knn_model"]][[model_name]] <- knn_model$kfold_rocobjs

# see the results
knn_model$model_summary %>% t()

##                                       [,1]
## k                               10.0000000
## auc                              0.9869974
## auc_optimism_corrected           0.7759750
## auc_optimism_corrected_CIL       0.6782309
## auc_optimism_corrected_CIU       0.8456175
## accuracy                         0.8248175
## accuracy_optimism_corrected      0.7595124
## accuracy_optimism_corrected_CIL  0.7042451
## accuracy_optimism_corrected_CIU  0.8175148

roc_c

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)


# prepare the data
filt_colon_uni_data <- binomial_prep(colon_asv_tab,
                                     colon_taxa_tab,
                                     colon_metadata,
                                     group, usage="ml_clr",
                                     patient = TRUE)

## Removing 848 ASV(s)

## Removing 45 ASV(s)

# fit the model
knn_model <- knn_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                          clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(knn_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["knn_model"]][[model_name]] <- knn_model$model_summary
supplements_models[["roc_cs"]][["knn_model"]][[model_name]] <- knn_model$kfold_rocobjs


# see the results
knn_model$model_summary %>% t()

##                                       [,1]
## k                               10.0000000
## auc                              0.9257194
## auc_optimism_corrected           0.5786678
## auc_optimism_corrected_CIL       0.5341015
## auc_optimism_corrected_CIU       0.6370718
## accuracy                         0.8452722
## accuracy_optimism_corrected      0.5668339
## accuracy_optimism_corrected_CIL  0.5115916
## accuracy_optimism_corrected_CIU  0.6118076

roc_c

post_ltx vs healthy

group <- c("post_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_asv_tab,
                                     colon_taxa_tab,
                                     colon_metadata,
                                     group, usage="ml_clr",
                                     patient = TRUE)

## Removing 1180 ASV(s)

## Removing 72 ASV(s)

# fit the model
knn_model <- knn_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                          clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(knn_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
# save the results
supplements_models[["models_summ"]][["knn_model"]][[model_name]] <- knn_model$model_summary
supplements_models[["roc_cs"]][["knn_model"]][[model_name]] <- knn_model$kfold_rocobjs

# see the results
knn_model$model_summary %>% t()

##                                       [,1]
## k                               10.0000000
## auc                              0.9760370
## auc_optimism_corrected           0.8605140
## auc_optimism_corrected_CIL       0.7570092
## auc_optimism_corrected_CIU       0.9766050
## accuracy                         0.8937198
## accuracy_optimism_corrected      0.7931394
## accuracy_optimism_corrected_CIL  0.6842176
## accuracy_optimism_corrected_CIU  0.8788913

roc_c

Genus level

level="genus"

Aggregate taxa

genus_data <- aggregate_taxa(colon_asv_tab,
                             colon_taxa_tab,
                             taxonomic_level = level)

colon_genus_tab <- genus_data[[1]]
colon_genus_taxa_tab <- genus_data[[2]]

pre_ltx vs healthy

group <- c("pre_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_genus_tab,
                                     colon_genus_taxa_tab,
                                     colon_metadata,
                                     group, 
                                     usage="ml_clr",
                                     patient = TRUE)

## Removing 54 ASV(s)

## Removing 11 ASV(s)

# fit the model
knn_model <- knn_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                          clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(knn_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["knn_model"]][[model_name]] <- knn_model$model_summary
supplements_models[["roc_cs"]][["knn_model"]][[model_name]] <- knn_model$kfold_rocobjs


# see the results
knn_model$model_summary %>% t()

##                                       [,1]
## k                               11.0000000
## auc                              0.9403045
## auc_optimism_corrected           0.8474865
## auc_optimism_corrected_CIL       0.7613057
## auc_optimism_corrected_CIU       0.8879084
## accuracy                         0.8832117
## accuracy_optimism_corrected      0.8062435
## accuracy_optimism_corrected_CIL  0.7098733
## accuracy_optimism_corrected_CIU  0.8462698

roc_c

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_genus_tab,
                                     colon_genus_taxa_tab,
                                     colon_metadata,
                                     group, 
                                     usage="ml_clr",
                                     patient = TRUE)

## Removing 18 ASV(s)

## Removing 13 ASV(s)

# fit the model
knn_model <- knn_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                          clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(knn_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["knn_model"]][[model_name]] <- knn_model$model_summary
supplements_models[["roc_cs"]][["knn_model"]][[model_name]] <- knn_model$kfold_rocobjs


# see the results
knn_model$model_summary %>% t()

##                                       [,1]
## k                               18.0000000
## auc                              0.8269060
## auc_optimism_corrected           0.5211152
## auc_optimism_corrected_CIL       0.4241497
## auc_optimism_corrected_CIU       0.6071406
## accuracy                         0.7191977
## accuracy_optimism_corrected      0.5276003
## accuracy_optimism_corrected_CIL  0.4455386
## accuracy_optimism_corrected_CIU  0.5700858

roc_c

post_ltx vs healthy

group <- c("post_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_genus_tab,
                                     colon_genus_taxa_tab,
                                     colon_metadata,
                                     group, 
                                     usage="ml_clr",
                                     patient = TRUE)

## Removing 97 ASV(s)

## Removing 7 ASV(s)

# fit the model
knn_model <- knn_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                          clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(knn_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["knn_model"]][[model_name]] <- knn_model$model_summary
supplements_models[["roc_cs"]][["knn_model"]][[model_name]] <- knn_model$kfold_rocobjs


# see the results
knn_model$model_summary %>% t()

##                                       [,1]
## k                               10.0000000
## auc                              0.9692671
## auc_optimism_corrected           0.8992102
## auc_optimism_corrected_CIL       0.8248738
## auc_optimism_corrected_CIU       0.9877840
## accuracy                         0.8937198
## accuracy_optimism_corrected      0.8169337
## accuracy_optimism_corrected_CIL  0.7354628
## accuracy_optimism_corrected_CIU  0.9507393

roc_c

Random Forest

model="rf"

ASV level

level="ASV"

pre_ltx vs healthy

group <- c("pre_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_asv_tab,
                                     colon_taxa_tab,
                                     colon_metadata,
                                     group, usage="ml_clr",
                                     patient = TRUE)

## Removing 900 ASV(s)

## Removing 78 ASV(s)

# fit the model
rf_model <- rf_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                        clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(rf_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["rf_model"]][[model_name]] <- rf_model$model_summary
supplements_models[["roc_cs"]][["rf_model"]][[model_name]] <- rf_model$kfold_rocobjs

# see the results
rf_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "117"      
## splitrule                       "gini"     
## min.node.size                   "2"        
## auc                             "1"        
## auc_optimism_corrected          "0.9497941"
## auc_optimism_corrected_CIL      "0.8885346"
## auc_optimism_corrected_CIU      "0.9896912"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.921224" 
## accuracy_optimism_corrected_CIL "0.8561052"
## accuracy_optimism_corrected_CIU "0.9715691"

roc_c

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_asv_tab,
                                     colon_taxa_tab,
                                     colon_metadata,
                                     group, usage="ml_clr",
                                     patient = TRUE)

## Removing 848 ASV(s)

## Removing 45 ASV(s)

# fit the model
rf_model <- rf_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                        clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(rf_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["rf_model"]][[model_name]] <- rf_model$model_summary
supplements_models[["roc_cs"]][["rf_model"]][[model_name]] <- rf_model$kfold_rocobjs

# see the results
rf_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "99"       
## splitrule                       "gini"     
## min.node.size                   "2"        
## auc                             "1"        
## auc_optimism_corrected          "0.6808152"
## auc_optimism_corrected_CIL      "0.5804338"
## auc_optimism_corrected_CIU      "0.7472019"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.634459" 
## accuracy_optimism_corrected_CIL "0.5855093"
## accuracy_optimism_corrected_CIU "0.7213764"

roc_c

post_ltx vs healthy

group <- c("post_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_asv_tab,
                                     colon_taxa_tab,
                                     colon_metadata,
                                     group, usage="ml_clr",
                                     patient = TRUE)

## Removing 1180 ASV(s)

## Removing 72 ASV(s)

# fit the model
rf_model <- rf_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                        clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(rf_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["rf_model"]][[model_name]] <- rf_model$model_summary
supplements_models[["roc_cs"]][["rf_model"]][[model_name]] <- rf_model$kfold_rocobjs

# see the results
rf_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "363"      
## splitrule                       "gini"     
## min.node.size                   "2"        
## auc                             "1"        
## auc_optimism_corrected          "0.8699486"
## auc_optimism_corrected_CIL      "0.7779758"
## auc_optimism_corrected_CIU      "0.9516733"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.823617" 
## accuracy_optimism_corrected_CIL "0.708467" 
## accuracy_optimism_corrected_CIU "0.9283133"

roc_c

Genus level

level="genus"

Aggregate taxa

genus_data <- aggregate_taxa(colon_asv_tab,
                             colon_taxa_tab,
                             taxonomic_level = level)

colon_genus_tab <- genus_data[[1]]
colon_genus_taxa_tab <- genus_data[[2]]

pre_ltx vs healthy

group <- c("pre_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_genus_tab,
                                     colon_genus_taxa_tab,
                                     colon_metadata,
                                     group, 
                                     usage="ml_clr",
                                     patient = TRUE)

## Removing 54 ASV(s)

## Removing 11 ASV(s)

# fit the model
rf_model <- rf_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                        clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(rf_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["rf_model"]][[model_name]] <- rf_model$model_summary
supplements_models[["roc_cs"]][["rf_model"]][[model_name]] <- rf_model$kfold_rocobjs

# see the results
rf_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "37"       
## splitrule                       "gini"     
## min.node.size                   "2"        
## auc                             "1"        
## auc_optimism_corrected          "0.8886183"
## auc_optimism_corrected_CIL      "0.7615653"
## auc_optimism_corrected_CIU      "0.9500028"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.8510081"
## accuracy_optimism_corrected_CIL "0.748883" 
## accuracy_optimism_corrected_CIU "0.9115807"

roc_c

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_genus_tab,
                                     colon_genus_taxa_tab,
                                     colon_metadata,
                                     group, 
                                     usage="ml_clr",
                                     patient = TRUE)

## Removing 18 ASV(s)

## Removing 13 ASV(s)

# fit the model
rf_model <- rf_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                        clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(rf_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["rf_model"]][[model_name]] <- rf_model$model_summary
supplements_models[["roc_cs"]][["rf_model"]][[model_name]] <- rf_model$kfold_rocobjs

# see the results
rf_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "35"       
## splitrule                       "gini"     
## min.node.size                   "5"        
## auc                             "1"        
## auc_optimism_corrected          "0.6793403"
## auc_optimism_corrected_CIL      "0.6124719"
## auc_optimism_corrected_CIU      "0.7595152"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.6269262"
## accuracy_optimism_corrected_CIL "0.5617618"
## accuracy_optimism_corrected_CIU "0.6826535"

roc_c

post_ltx vs healthy

group <- c("post_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_genus_tab,
                                     colon_genus_taxa_tab,
                                     colon_metadata,
                                     group, 
                                     usage="ml_clr",
                                     patient = TRUE)

## Removing 97 ASV(s)

## Removing 7 ASV(s)

# fit the model
rf_model <- rf_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                        clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(rf_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["rf_model"]][[model_name]] <- rf_model$model_summary
supplements_models[["roc_cs"]][["rf_model"]][[model_name]] <- rf_model$kfold_rocobjs

# see the results
rf_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "15"       
## splitrule                       "gini"     
## min.node.size                   "2"        
## auc                             "1"        
## auc_optimism_corrected          "0.921861" 
## auc_optimism_corrected_CIL      "0.8673639"
## auc_optimism_corrected_CIU      "0.9623318"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.8702487"
## accuracy_optimism_corrected_CIL "0.774093" 
## accuracy_optimism_corrected_CIU "0.9292183"

roc_c

Gradient boosting

model="gb"

ASV level

level="ASV"

pre_ltx vs healthy

group <- c("pre_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_asv_tab,
                                     colon_taxa_tab,
                                     colon_metadata,
                                     group, usage="ml_clr",
                                     patient = TRUE)

## Removing 900 ASV(s)

## Removing 78 ASV(s)

# fit the model
gbm_model <- gbm_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                          clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(gbm_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["gbm_model"]][[model_name]] <- gbm_model$model_summary
supplements_models[["roc_cs"]][["gbm_model"]][[model_name]] <- gbm_model$kfold_rocobjs

# see the results
gbm_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "15"       
## splitrule                       "gini"     
## min.node.size                   "2"        
## auc                             "1"        
## auc_optimism_corrected          "0.921861" 
## auc_optimism_corrected_CIL      "0.8673639"
## auc_optimism_corrected_CIU      "0.9623318"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.8702487"
## accuracy_optimism_corrected_CIL "0.774093" 
## accuracy_optimism_corrected_CIU "0.9292183"

roc_c

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_asv_tab,
                                     colon_taxa_tab,
                                     colon_metadata,
                                     group, usage="ml_clr",
                                     patient = TRUE)

## Removing 848 ASV(s)

## Removing 45 ASV(s)

# fit the model
gbm_model <- gbm_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                          clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(gbm_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["gbm_model"]][[model_name]] <- gbm_model$model_summary
supplements_models[["roc_cs"]][["gbm_model"]][[model_name]] <- gbm_model$kfold_rocobjs


# see the results
gbm_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "15"       
## splitrule                       "gini"     
## min.node.size                   "2"        
## auc                             "1"        
## auc_optimism_corrected          "0.921861" 
## auc_optimism_corrected_CIL      "0.8673639"
## auc_optimism_corrected_CIU      "0.9623318"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.8702487"
## accuracy_optimism_corrected_CIL "0.774093" 
## accuracy_optimism_corrected_CIU "0.9292183"

roc_c

post_ltx vs healthy

group <- c("post_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_asv_tab,
                                     colon_taxa_tab,
                                     colon_metadata,
                                     group, usage="ml_clr",
                                     patient = TRUE)

## Removing 1180 ASV(s)

## Removing 72 ASV(s)

# fit the model
gbm_model <- gbm_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                          clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(gbm_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["gbm_model"]][[model_name]] <- gbm_model$model_summary
supplements_models[["roc_cs"]][["gbm_model"]][[model_name]] <- gbm_model$kfold_rocobjs


# see the results
gbm_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "15"       
## splitrule                       "gini"     
## min.node.size                   "2"        
## auc                             "1"        
## auc_optimism_corrected          "0.921861" 
## auc_optimism_corrected_CIL      "0.8673639"
## auc_optimism_corrected_CIU      "0.9623318"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.8702487"
## accuracy_optimism_corrected_CIL "0.774093" 
## accuracy_optimism_corrected_CIU "0.9292183"

roc_c

Genus level

level="genus"

Aggregate taxa

genus_data <- aggregate_taxa(colon_asv_tab,
                             colon_taxa_tab,
                             taxonomic_level = level)

colon_genus_tab <- genus_data[[1]]
colon_genus_taxa_tab <- genus_data[[2]]

pre_ltx vs healthy

group <- c("pre_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_genus_tab,
                                     colon_genus_taxa_tab,
                                     colon_metadata,
                                     group, 
                                     usage="ml_clr",
                                     patient = TRUE)

## Removing 54 ASV(s)

## Removing 11 ASV(s)

# fit the model
gbm_model <- gbm_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                          clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(gbm_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["gbm_model"]][[model_name]] <- gbm_model$model_summary
supplements_models[["roc_cs"]][["gbm_model"]][[model_name]] <- gbm_model$kfold_rocobjs

# see the results
gbm_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "15"       
## splitrule                       "gini"     
## min.node.size                   "2"        
## auc                             "1"        
## auc_optimism_corrected          "0.921861" 
## auc_optimism_corrected_CIL      "0.8673639"
## auc_optimism_corrected_CIU      "0.9623318"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.8702487"
## accuracy_optimism_corrected_CIL "0.774093" 
## accuracy_optimism_corrected_CIU "0.9292183"

roc_c

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_genus_tab,
                                     colon_genus_taxa_tab,
                                     colon_metadata,
                                     group, 
                                     usage="ml_clr",
                                     patient = TRUE)

## Removing 18 ASV(s)

## Removing 13 ASV(s)

# fit the model
gbm_model <- gbm_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                          clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(gbm_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["gbm_model"]][[model_name]] <- gbm_model$model_summary
supplements_models[["roc_cs"]][["gbm_model"]][[model_name]] <- gbm_model$kfold_rocobjs

# see the results
gbm_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "15"       
## splitrule                       "gini"     
## min.node.size                   "2"        
## auc                             "1"        
## auc_optimism_corrected          "0.921861" 
## auc_optimism_corrected_CIL      "0.8673639"
## auc_optimism_corrected_CIU      "0.9623318"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.8702487"
## accuracy_optimism_corrected_CIL "0.774093" 
## accuracy_optimism_corrected_CIU "0.9292183"

roc_c

post_ltx vs healthy

group <- c("post_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_genus_tab,
                                     colon_genus_taxa_tab,
                                     colon_metadata,
                                     group, 
                                     usage="ml_clr",
                                     patient = TRUE)

## Removing 97 ASV(s)

## Removing 7 ASV(s)

# fit the model
gbm_model <- gbm_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                          clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(gbm_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["gbm_model"]][[model_name]] <- gbm_model$model_summary
supplements_models[["roc_cs"]][["gbm_model"]][[model_name]] <- gbm_model$kfold_rocobjs

# see the results
gbm_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "15"       
## splitrule                       "gini"     
## min.node.size                   "2"        
## auc                             "1"        
## auc_optimism_corrected          "0.921861" 
## auc_optimism_corrected_CIL      "0.8673639"
## auc_optimism_corrected_CIU      "0.9623318"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.8702487"
## accuracy_optimism_corrected_CIL "0.774093" 
## accuracy_optimism_corrected_CIU "0.9292183"

roc_c

Relative abundances

Elastic net

ASV level

level="ASV"

pre_ltx vs healthy

group <- c("pre_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_asv_tab,
                                     colon_taxa_tab,
                                     colon_metadata,
                                     group, usage="ml_ra",
                                     patient = TRUE)

## Removing 900 ASV(s)

## Removing 78 ASV(s)

# fit the model
enet_model <- glmnet_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(enet_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["enet_model_ra"]][[model_name]] <- enet_model$model_summary

supplements_models[["roc_cs"]][["enet_model_ra"]][[model_name]] <- enet_model$kfold_rocobjs

# see the results
enet_model$model_summary %>% t()

##                                        [,1]
## alpha                           0.400000000
## lambda                          0.009606311
## auc                             1.000000000
## auc_czech                               NaN
## auc_no                          1.000000000
## auc_optimism_corrected          0.947591655
## auc_optimism_corrected_CIL      0.899070840
## auc_optimism_corrected_CIU      0.974258612
## accuracy                        1.000000000
## accuracy_czech                          NaN
## accuracy_no                     1.000000000
## accuracy_optimism_corrected     0.892267728
## accuracy_optimism_corrected_CIL 0.862237493
## accuracy_optimism_corrected_CIU 0.922722017

roc_c

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_asv_tab,
                                     colon_taxa_tab,
                                     colon_metadata,
                                     group, usage="ml_ra",
                                     patient = TRUE)

## Removing 848 ASV(s)

## Removing 45 ASV(s)

# fit the model
enet_model <- glmnet_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(enet_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["enet_model_ra"]][[model_name]] <- enet_model$model_summary

supplements_models[["roc_cs"]][["enet_model_ra"]][[model_name]] <- enet_model$kfold_rocobjs

# see the results
enet_model$model_summary %>% t()

##                                       [,1]
## alpha                           0.20000000
## lambda                          0.01370467
## auc                             1.00000000
## auc_czech                              NaN
## auc_no                          1.00000000
## auc_optimism_corrected          0.62011993
## auc_optimism_corrected_CIL      0.46329550
## auc_optimism_corrected_CIU      0.70305244
## accuracy                        1.00000000
## accuracy_czech                         NaN
## accuracy_no                     1.00000000
## accuracy_optimism_corrected     0.61154629
## accuracy_optimism_corrected_CIL 0.51705662
## accuracy_optimism_corrected_CIU 0.68614943

roc_c

post_ltx vs healthy

group <- c("post_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)


# prepare the data
filt_colon_uni_data <- binomial_prep(colon_asv_tab,
                                     colon_taxa_tab,
                                     colon_metadata,
                                     group, usage="ml_ra",
                                     patient = TRUE)

## Removing 1180 ASV(s)

## Removing 72 ASV(s)

# fit the model
enet_model <- glmnet_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(enet_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["enet_model_ra"]][[model_name]] <- enet_model$model_summary

supplements_models[["roc_cs"]][["enet_model_ra"]][[model_name]] <- enet_model$kfold_rocobjs

# see the results
enet_model$model_summary %>% t()

##                                       [,1]
## alpha                           0.20000000
## lambda                          0.01558488
## auc                             1.00000000
## auc_czech                              NaN
## auc_no                          1.00000000
## auc_optimism_corrected          0.93333079
## auc_optimism_corrected_CIL      0.83566515
## auc_optimism_corrected_CIU      0.99515723
## accuracy                        1.00000000
## accuracy_czech                         NaN
## accuracy_no                     1.00000000
## accuracy_optimism_corrected     0.89119078
## accuracy_optimism_corrected_CIL 0.80403241
## accuracy_optimism_corrected_CIU 0.96838262

roc_c

Genus level

level="genus"

Aggregate taxa

genus_data <- aggregate_taxa(colon_asv_tab,
                             colon_taxa_tab,
                             taxonomic_level = level)

colon_genus_tab <- genus_data[[1]]
colon_genus_taxa_tab <- genus_data[[2]]

pre_ltx vs healthy

group <- c("pre_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_genus_tab,
                                     colon_genus_taxa_tab,
                                     colon_metadata,
                                     group, 
                                     usage="ml_ra",
                                     patient = TRUE)

## Removing 54 ASV(s)

## Removing 11 ASV(s)

# fit the model
enet_model <- glmnet_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(enet_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["enet_model_ra"]][[model_name]] <- enet_model$model_summary

supplements_models[["roc_cs"]][["enet_model_ra"]][[model_name]] <- enet_model$kfold_rocobjs

# see the results
enet_model$model_summary %>% t()

##                                        [,1]
## alpha                           0.800000000
## lambda                          0.008018801
## auc                             1.000000000
## auc_czech                               NaN
## auc_no                          1.000000000
## auc_optimism_corrected          0.932350797
## auc_optimism_corrected_CIL      0.876282619
## auc_optimism_corrected_CIU      0.967590093
## accuracy                        1.000000000
## accuracy_czech                          NaN
## accuracy_no                     1.000000000
## accuracy_optimism_corrected     0.867933194
## accuracy_optimism_corrected_CIL 0.835989305
## accuracy_optimism_corrected_CIU 0.909881423

roc_c

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)


# prepare the data
filt_colon_uni_data <- binomial_prep(colon_genus_tab,
                                     colon_genus_taxa_tab,
                                     colon_metadata,
                                     group, 
                                     usage="ml_ra",
                                     patient = TRUE)

## Removing 18 ASV(s)

## Removing 13 ASV(s)

# fit the model
enet_model <- glmnet_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(enet_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["enet_model_ra"]][[model_name]] <- enet_model$model_summary

supplements_models[["roc_cs"]][["enet_model_ra"]][[model_name]] <- enet_model$kfold_rocobjs

# see the results
enet_model$model_summary %>% t()

##                                       [,1]
## alpha                           0.40000000
## lambda                          0.01329698
## auc                             0.99440807
## auc_czech                              NaN
## auc_no                          0.99440807
## auc_optimism_corrected          0.56903725
## auc_optimism_corrected_CIL      0.49166629
## auc_optimism_corrected_CIU      0.70965158
## accuracy                        0.95988539
## accuracy_czech                         NaN
## accuracy_no                     0.95988539
## accuracy_optimism_corrected     0.57568545
## accuracy_optimism_corrected_CIL 0.51044438
## accuracy_optimism_corrected_CIU 0.69125450

roc_c

post_ltx vs healthy

group <- c("post_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_genus_tab,
                                     colon_genus_taxa_tab,
                                     colon_metadata,
                                     group, 
                                     usage="ml_ra",
                                     patient = TRUE)

## Removing 97 ASV(s)

## Removing 7 ASV(s)

# fit the model
enet_model <- glmnet_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                              clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(enet_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["enet_model_ra"]][[model_name]] <- enet_model$model_summary

supplements_models[["roc_cs"]][["enet_model_ra"]][[model_name]] <- enet_model$kfold_rocobjs

# see the results
enet_model$model_summary %>% t()

##                                       [,1]
## alpha                           0.20000000
## lambda                          0.01423325
## auc                             1.00000000
## auc_czech                              NaN
## auc_no                          1.00000000
## auc_optimism_corrected          0.93130864
## auc_optimism_corrected_CIL      0.82913832
## auc_optimism_corrected_CIU      0.99967201
## accuracy                        1.00000000
## accuracy_czech                         NaN
## accuracy_no                     1.00000000
## accuracy_optimism_corrected     0.88561761
## accuracy_optimism_corrected_CIL 0.77563966
## accuracy_optimism_corrected_CIU 0.96448141

roc_c

kNN

ASV level

level="ASV"

pre_ltx vs healthy

group <- c("pre_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_asv_tab,
                                     colon_taxa_tab,
                                     colon_metadata,
                                     group, usage="ml_ra",
                                     patient = TRUE)

## Removing 900 ASV(s)

## Removing 78 ASV(s)

# fit the model
knn_model <- knn_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                          clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(knn_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["knn_model_ra"]][[model_name]] <- knn_model$model_summary

supplements_models[["roc_cs"]][["knn_model_ra"]][[model_name]] <- knn_model$kfold_rocobjs

# see the results
knn_model$model_summary %>% t()

##                                       [,1]
## k                               13.0000000
## auc                              0.9579691
## auc_optimism_corrected           0.8543447
## auc_optimism_corrected_CIL       0.7234433
## auc_optimism_corrected_CIU       0.9347518
## accuracy                         0.9160584
## accuracy_optimism_corrected      0.8231328
## accuracy_optimism_corrected_CIL  0.7320056
## accuracy_optimism_corrected_CIU  0.9164786

roc_c

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_asv_tab,
                                     colon_taxa_tab,
                                     colon_metadata,
                                     group, usage="ml_ra",
                                     patient = TRUE)

## Removing 848 ASV(s)

## Removing 45 ASV(s)

# fit the model
knn_model <- knn_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                          clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(knn_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["knn_model_ra"]][[model_name]] <- knn_model$model_summary

supplements_models[["roc_cs"]][["knn_model_ra"]][[model_name]] <- knn_model$kfold_rocobjs

# see the results
knn_model$model_summary %>% t()

##                                       [,1]
## k                               21.0000000
## auc                              0.7521652
## auc_optimism_corrected           0.5417615
## auc_optimism_corrected_CIL       0.4604685
## auc_optimism_corrected_CIU       0.6299550
## accuracy                         0.7134670
## accuracy_optimism_corrected      0.5406239
## accuracy_optimism_corrected_CIL  0.4521977
## accuracy_optimism_corrected_CIU  0.6040405

roc_c

post_ltx vs healthy

group <- c("post_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_asv_tab,
                                     colon_taxa_tab,
                                     colon_metadata,
                                     group, usage="ml_ra",
                                     patient = TRUE)

## Removing 1180 ASV(s)

## Removing 72 ASV(s)

# fit the model
knn_model <- knn_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                          clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(knn_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["knn_model_ra"]][[model_name]] <- knn_model$model_summary

supplements_models[["roc_cs"]][["knn_model_ra"]][[model_name]] <- knn_model$kfold_rocobjs

# see the results
knn_model$model_summary %>% t()

##                                       [,1]
## k                               10.0000000
## auc                              0.9742639
## auc_optimism_corrected           0.8879882
## auc_optimism_corrected_CIL       0.8419757
## auc_optimism_corrected_CIU       0.9598700
## accuracy                         0.8985507
## accuracy_optimism_corrected      0.7933714
## accuracy_optimism_corrected_CIL  0.7270877
## accuracy_optimism_corrected_CIU  0.8956349

roc_c

Genus level

level="genus"

Aggregate taxa

genus_data <- aggregate_taxa(colon_asv_tab,
                             colon_taxa_tab,
                             taxonomic_level = level)

colon_genus_tab <- genus_data[[1]]
colon_genus_taxa_tab <- genus_data[[2]]

pre_ltx vs healthy

group <- c("pre_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_genus_tab,
                                     colon_genus_taxa_tab,
                                     colon_metadata,
                                     group, 
                                     usage="ml_ra",
                                     patient = TRUE)

## Removing 54 ASV(s)

## Removing 11 ASV(s)

# fit the model
knn_model <- knn_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                          clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(knn_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["knn_model_ra"]][[model_name]] <- knn_model$model_summary

supplements_models[["roc_cs"]][["knn_model_ra"]][[model_name]] <- knn_model$kfold_rocobjs

# see the results
knn_model$model_summary %>% t()

##                                       [,1]
## k                               13.0000000
## auc                              0.9594988
## auc_optimism_corrected           0.8591223
## auc_optimism_corrected_CIL       0.7808096
## auc_optimism_corrected_CIU       0.9187468
## accuracy                         0.8978102
## accuracy_optimism_corrected      0.8000668
## accuracy_optimism_corrected_CIL  0.7431141
## accuracy_optimism_corrected_CIU  0.8514205

roc_c

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_genus_tab,
                                     colon_genus_taxa_tab,
                                     colon_metadata,
                                     group, 
                                     usage="ml_ra",
                                     patient = TRUE)

## Removing 18 ASV(s)

## Removing 13 ASV(s)

# fit the model
knn_model <- knn_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                          clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(knn_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["knn_model_ra"]][[model_name]] <- knn_model$model_summary

supplements_models[["roc_cs"]][["knn_model_ra"]][[model_name]] <- knn_model$kfold_rocobjs

# see the results
knn_model$model_summary %>% t()

##                                       [,1]
## k                               10.0000000
## auc                              0.8530244
## auc_optimism_corrected           0.5667836
## auc_optimism_corrected_CIL       0.4945097
## auc_optimism_corrected_CIU       0.6440563
## accuracy                         0.7707736
## accuracy_optimism_corrected      0.5636036
## accuracy_optimism_corrected_CIL  0.4960163
## accuracy_optimism_corrected_CIU  0.6227429

roc_c

post_ltx vs healthy

group <- c("post_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_genus_tab,
                                     colon_genus_taxa_tab,
                                     colon_metadata,
                                     group, 
                                     usage="ml_ra",
                                     patient = TRUE)

## Removing 97 ASV(s)

## Removing 7 ASV(s)

# fit the model
knn_model <- knn_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                          clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(knn_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["knn_model_ra"]][[model_name]] <- knn_model$model_summary

supplements_models[["roc_cs"]][["knn_model_ra"]][[model_name]] <- knn_model$kfold_rocobjs

# see the results
knn_model$model_summary %>% t()

##                                       [,1]
## k                               11.0000000
## auc                              0.9673866
## auc_optimism_corrected           0.8764406
## auc_optimism_corrected_CIL       0.8109556
## auc_optimism_corrected_CIU       0.9573980
## accuracy                         0.8937198
## accuracy_optimism_corrected      0.7743467
## accuracy_optimism_corrected_CIL  0.6910492
## accuracy_optimism_corrected_CIU  0.8240199

roc_c

Random Forest

ASV level

level="ASV"

pre_ltx vs healthy

group <- c("pre_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_asv_tab,
                                     colon_taxa_tab,
                                     colon_metadata,
                                     group, usage="ml_ra",
                                     patient = TRUE)

## Removing 900 ASV(s)

## Removing 78 ASV(s)

# fit the model
rf_model <- rf_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                        clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(rf_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["rf_model_ra"]][[model_name]] <- rf_model$model_summary

supplements_models[["roc_cs"]][["rf_model_ra"]][[model_name]] <- rf_model$kfold_rocobjs

# see the results
rf_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "31"       
## splitrule                       "gini"     
## min.node.size                   "2"        
## auc                             "1"        
## auc_optimism_corrected          "0.979444" 
## auc_optimism_corrected_CIL      "0.9341725"
## auc_optimism_corrected_CIU      "0.9998634"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.9463362"
## accuracy_optimism_corrected_CIL "0.9113375"
## accuracy_optimism_corrected_CIU "0.9778581"

roc_c

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_asv_tab,
                                     colon_taxa_tab,
                                     colon_metadata,
                                     group, usage="ml_ra",
                                     patient = TRUE)

## Removing 848 ASV(s)

## Removing 45 ASV(s)

# fit the model
rf_model <- rf_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                        clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(rf_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["rf_model_ra"]][[model_name]] <- rf_model$model_summary

supplements_models[["roc_cs"]][["rf_model_ra"]][[model_name]] <- rf_model$kfold_rocobjs


# see the results
rf_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "25"       
## splitrule                       "gini"     
## min.node.size                   "5"        
## auc                             "1"        
## auc_optimism_corrected          "0.7162147"
## auc_optimism_corrected_CIL      "0.5860801"
## auc_optimism_corrected_CIU      "0.8050504"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.6205396"
## accuracy_optimism_corrected_CIL "0.5508295"
## accuracy_optimism_corrected_CIU "0.7017938"

roc_c

post_ltx vs healthy

group <- c("post_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_asv_tab,
                                     colon_taxa_tab,
                                     colon_metadata,
                                     group, usage="ml_ra",
                                     patient = TRUE)

## Removing 1180 ASV(s)

## Removing 72 ASV(s)

# fit the model
rf_model <- rf_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                        clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(rf_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["rf_model_ra"]][[model_name]] <- rf_model$model_summary

supplements_models[["roc_cs"]][["rf_model_ra"]][[model_name]] <- rf_model$kfold_rocobjs


# see the results
rf_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "37"       
## splitrule                       "gini"     
## min.node.size                   "2"        
## auc                             "1"        
## auc_optimism_corrected          "0.9271191"
## auc_optimism_corrected_CIL      "0.7769949"
## auc_optimism_corrected_CIU      "0.9973397"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.8787146"
## accuracy_optimism_corrected_CIL "0.6477571"
## accuracy_optimism_corrected_CIU "0.9672643"

roc_c

Genus level

level="genus"

Aggregate taxa

genus_data <- aggregate_taxa(colon_asv_tab,
                             colon_taxa_tab,
                             taxonomic_level = level)

colon_genus_tab <- genus_data[[1]]
colon_genus_taxa_tab <- genus_data[[2]]

pre_ltx vs healthy

group <- c("pre_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_genus_tab,
                                     colon_genus_taxa_tab,
                                     colon_metadata,
                                     group, 
                                     usage="ml_ra",
                                     patient = TRUE)

## Removing 54 ASV(s)

## Removing 11 ASV(s)

# fit the model
rf_model <- rf_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                        clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(rf_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["rf_model_ra"]][[model_name]] <- rf_model$model_summary

supplements_models[["roc_cs"]][["rf_model_ra"]][[model_name]] <- rf_model$kfold_rocobjs


# see the results
rf_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "23"       
## splitrule                       "gini"     
## min.node.size                   "5"        
## auc                             "1"        
## auc_optimism_corrected          "0.9294544"
## auc_optimism_corrected_CIL      "0.8121411"
## auc_optimism_corrected_CIU      "0.9869692"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.8674135"
## accuracy_optimism_corrected_CIL "0.7694632"
## accuracy_optimism_corrected_CIU "0.9201563"

roc_c

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_genus_tab,
                                     colon_genus_taxa_tab,
                                     colon_metadata,
                                     group, 
                                     usage="ml_ra",
                                     patient = TRUE)

## Removing 18 ASV(s)

## Removing 13 ASV(s)

# fit the model
rf_model <- rf_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                        clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(rf_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["rf_model_ra"]][[model_name]] <- rf_model$model_summary

supplements_models[["roc_cs"]][["rf_model_ra"]][[model_name]] <- rf_model$kfold_rocobjs


# see the results
rf_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "11"       
## splitrule                       "gini"     
## min.node.size                   "2"        
## auc                             "1"        
## auc_optimism_corrected          "0.6710997"
## auc_optimism_corrected_CIL      "0.6003336"
## auc_optimism_corrected_CIU      "0.7269684"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.6297913"
## accuracy_optimism_corrected_CIL "0.5852466"
## accuracy_optimism_corrected_CIU "0.6918579"

roc_c

post_ltx vs healthy

group <- c("post_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_genus_tab,
                                     colon_genus_taxa_tab,
                                     colon_metadata,
                                     group, 
                                     usage="ml_ra",
                                     patient = TRUE)

## Removing 97 ASV(s)

## Removing 7 ASV(s)

# fit the model
rf_model <- rf_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                        clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(rf_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["rf_model_ra"]][[model_name]] <- rf_model$model_summary

supplements_models[["roc_cs"]][["rf_model_ra"]][[model_name]] <- rf_model$kfold_rocobjs


# see the results
rf_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "79"       
## splitrule                       "gini"     
## min.node.size                   "5"        
## auc                             "1"        
## auc_optimism_corrected          "0.9489647"
## auc_optimism_corrected_CIL      "0.9056533"
## auc_optimism_corrected_CIU      "0.9994898"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.920142" 
## accuracy_optimism_corrected_CIL "0.8458387"
## accuracy_optimism_corrected_CIU "0.9943038"

roc_c

Gradient boosting

ASV level

level="ASV"

pre_ltx vs healthy

group <- c("pre_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_asv_tab,
                                     colon_taxa_tab,
                                     colon_metadata,
                                     group, usage="ml_ra",
                                     patient = TRUE)

## Removing 900 ASV(s)

## Removing 78 ASV(s)

# fit the model
gbm_model <- gbm_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                          clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(gbm_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["gbm_model_ra"]][[model_name]] <- gbm_model$model_summary

supplements_models[["roc_cs"]][["gbm_model_ra"]][[model_name]] <- gbm_model$kfold_rocobjs

# see the results
gbm_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "79"       
## splitrule                       "gini"     
## min.node.size                   "5"        
## auc                             "1"        
## auc_optimism_corrected          "0.9489647"
## auc_optimism_corrected_CIL      "0.9056533"
## auc_optimism_corrected_CIU      "0.9994898"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.920142" 
## accuracy_optimism_corrected_CIL "0.8458387"
## accuracy_optimism_corrected_CIU "0.9943038"

roc_c

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_asv_tab,
                                     colon_taxa_tab,
                                     colon_metadata,
                                     group, usage="ml_ra",
                                     patient = TRUE)

## Removing 848 ASV(s)

## Removing 45 ASV(s)

# fit the model
gbm_model <- gbm_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                          clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(gbm_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["gbm_model_ra"]][[model_name]] <- gbm_model$model_summary

supplements_models[["roc_cs"]][["gbm_model_ra"]][[model_name]] <- gbm_model$kfold_rocobjs

# see the results
gbm_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "79"       
## splitrule                       "gini"     
## min.node.size                   "5"        
## auc                             "1"        
## auc_optimism_corrected          "0.9489647"
## auc_optimism_corrected_CIL      "0.9056533"
## auc_optimism_corrected_CIU      "0.9994898"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.920142" 
## accuracy_optimism_corrected_CIL "0.8458387"
## accuracy_optimism_corrected_CIU "0.9943038"

roc_c

post_ltx vs healthy

group <- c("post_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_asv_tab,
                                     colon_taxa_tab,
                                     colon_metadata,
                                     group, usage="ml_ra",
                                     patient = TRUE)

## Removing 1180 ASV(s)

## Removing 72 ASV(s)

# fit the model
gbm_model <- gbm_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                          clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(gbm_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["gbm_model_ra"]][[model_name]] <- gbm_model$model_summary

supplements_models[["roc_cs"]][["gbm_model_ra"]][[model_name]] <- gbm_model$kfold_rocobjs

# see the results
gbm_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "79"       
## splitrule                       "gini"     
## min.node.size                   "5"        
## auc                             "1"        
## auc_optimism_corrected          "0.9489647"
## auc_optimism_corrected_CIL      "0.9056533"
## auc_optimism_corrected_CIU      "0.9994898"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.920142" 
## accuracy_optimism_corrected_CIL "0.8458387"
## accuracy_optimism_corrected_CIU "0.9943038"

roc_c

Genus level

level="genus"

Aggregate taxa

genus_data <- aggregate_taxa(colon_asv_tab,
                             colon_taxa_tab,
                             taxonomic_level = level)

colon_genus_tab <- genus_data[[1]]
colon_genus_taxa_tab <- genus_data[[2]]

pre_ltx vs healthy

group <- c("pre_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_genus_tab,
                                     colon_genus_taxa_tab,
                                     colon_metadata,
                                     group, 
                                     usage="ml_ra",
                                     patient = TRUE)

## Removing 54 ASV(s)

## Removing 11 ASV(s)

# fit the model
gbm_model <- gbm_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                          clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(gbm_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["gbm_model_ra"]][[model_name]] <- gbm_model$model_summary

supplements_models[["roc_cs"]][["gbm_model_ra"]][[model_name]] <- gbm_model$kfold_rocobjs

# see the results
gbm_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "79"       
## splitrule                       "gini"     
## min.node.size                   "5"        
## auc                             "1"        
## auc_optimism_corrected          "0.9489647"
## auc_optimism_corrected_CIL      "0.9056533"
## auc_optimism_corrected_CIU      "0.9994898"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.920142" 
## accuracy_optimism_corrected_CIL "0.8458387"
## accuracy_optimism_corrected_CIU "0.9943038"

roc_c

pre_ltx vs post_ltx

group <- c("pre_ltx","post_ltx")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_genus_tab,
                                     colon_genus_taxa_tab,
                                     colon_metadata,
                                     group, 
                                     usage="ml_ra",
                                     patient = TRUE)

## Removing 18 ASV(s)

## Removing 13 ASV(s)

# fit the model
gbm_model <- gbm_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                          clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(gbm_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["gbm_model_ra"]][[model_name]] <- gbm_model$model_summary

supplements_models[["roc_cs"]][["gbm_model_ra"]][[model_name]] <- gbm_model$kfold_rocobjs

# see the results
gbm_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "79"       
## splitrule                       "gini"     
## min.node.size                   "5"        
## auc                             "1"        
## auc_optimism_corrected          "0.9489647"
## auc_optimism_corrected_CIL      "0.9056533"
## auc_optimism_corrected_CIU      "0.9994898"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.920142" 
## accuracy_optimism_corrected_CIL "0.8458387"
## accuracy_optimism_corrected_CIU "0.9943038"

roc_c

post_ltx vs healthy

group <- c("post_ltx","healthy")
comparison_name <- paste0(group[1], " vs ",group[2])

model_name <- paste(comparison_name,level,segment)

# prepare the data
filt_colon_uni_data <- binomial_prep(colon_genus_tab,
                                     colon_genus_taxa_tab,
                                     colon_metadata,
                                     group, 
                                     usage="ml_ra",
                                     patient = TRUE)

## Removing 97 ASV(s)

## Removing 7 ASV(s)

# fit the model
gbm_model <- gbm_binomial(filt_colon_uni_data,
                              sample_method = "atypboot",
                              outcome="Group", 
                              N=10,
                          clust_var="Patient",
                              reuse=TRUE,
                              file=model_name,
                              Q="Q1_norway")

# ROC curve
roc_c <- roc_curve(gbm_model, group)

## Warning in geom_line(aes(x = `1-specificity`, y = sensitivity, by = name, : Ignoring unknown aesthetics: by

# save the results
supplements_models[["models_summ"]][["gbm_model_ra"]][[model_name]] <- gbm_model$model_summary

supplements_models[["roc_cs"]][["gbm_model_ra"]][[model_name]] <- gbm_model$kfold_rocobjs

# see the results
gbm_model$model_summary %>% t()

##                                 [,1]       
## mtry                            "79"       
## splitrule                       "gini"     
## min.node.size                   "5"        
## auc                             "1"        
## auc_optimism_corrected          "0.9489647"
## auc_optimism_corrected_CIL      "0.9056533"
## auc_optimism_corrected_CIU      "0.9994898"
## accuracy                        "1"        
## accuracy_optimism_corrected     "0.920142" 
## accuracy_optimism_corrected_CIL "0.8458387"
## accuracy_optimism_corrected_CIU "0.9943038"

roc_c

Saving results

models_list <- list()

for (model_name in names(supplements_models$models_summ)){
  df <- do.call(rbind, supplements_models$models_summ[[model_name]])
  models_list[[model_name]] <- df
}

write.xlsx(models_list,
           file=file.path(path,paste0("supplements_models_",segment,".xlsx")),
           rowNames=TRUE)

Results overview

Alpha diversity

pc_observed[[segment]]

pc_shannon[[segment]]

pc_simpson[[segment]]

pc_pielou[[segment]]

Plots

alpha_div_plots[[paste(segment,"Country")]]

## NULL

alpha_div_plots[[paste(segment,"Custom")]]

Beta diversity

Main results

pairwise_aitchison_raw[[paste("genus", segment)]]

PCA

pca_plots_list[[paste(segment,"genus custom")]]

Supplements

knitr::kable(supplements_beta[!grepl("PCoA",names(supplements_beta))],
             digits = 3,
             caption = "Supplementary PERMANOVA results")

Supplementary PERMANOVA results

pairs Df SumsOfSqs F.Model R2 p.value p.adjusted sig pre_ltx vs healthy 1 1.000 5.257 0.062 0.001 0.002 ** pre_ltx vs post_ltx 1 0.442 2.053 0.025 0.011 0.011 * post_ltx vs healthy 1 1.165 6.012 0.079 0.001 0.002 **

pairs Df SumsOfSqs F.Model R2 p.value p.adjusted sig pre_ltx vs healthy 1 1.114 4.010 0.048 0.001 0.002 ** pre_ltx vs post_ltx 1 0.512 1.694 0.021 0.013 0.013 * post_ltx vs healthy 1 1.225 4.313 0.058 0.001 0.002 **

pairs Df SumsOfSqs F.Model R2 p.value p.adjusted sig pre_ltx vs healthy 1 1022.375 3.249 0.039 0.001 0.001 *** pre_ltx vs post_ltx 1 500.838 1.753 0.021 0.001 0.001 *** post_ltx vs healthy 1 975.120 3.241 0.044 0.001 0.001 ***

pairs Df SumsOfSqs F.Model R2 p.value p.adjusted sig pre_ltx vs healthy 1 1.502 4.843 0.057 0.001 0.002 ** pre_ltx vs post_ltx 1 0.648 1.964 0.024 0.004 0.004 ** post_ltx vs healthy 1 1.599 5.137 0.068 0.001 0.002 **

pairs Df SumsOfSqs F.Model R2 p.value p.adjusted sig pre_ltx vs healthy 1 1.275 3.334 0.040 0.001 0.002 ** pre_ltx vs post_ltx 1 0.626 1.579 0.019 0.003 0.003 ** post_ltx vs healthy 1 1.319 3.438 0.047 0.001 0.002 **

pairs Df SumsOfSqs F.Model R2 p.value p.adjusted sig pre_ltx vs healthy 1 2.224 10.918 0.039 0.001 0.002 ** pre_ltx vs post_ltx 1 1.173 5.414 0.015 0.052 0.052 post_ltx vs healthy 1 2.984 14.912 0.068 0.001 0.002 **

pairs Df SumsOfSqs F.Model R2 p.value p.adjusted sig pre_ltx vs healthy 1 2.407 8.288 0.030 0.001 0.002 ** pre_ltx vs post_ltx 1 1.254 4.150 0.012 0.078 0.078 post_ltx vs healthy 1 3.048 10.592 0.049 0.001 0.002 **

pairs Df SumsOfSqs F.Model R2 p.value p.adjusted sig pre_ltx vs healthy 1 2143.719 7.928 0.028 0.001 0.002 ** pre_ltx vs post_ltx 1 936.918 3.682 0.011 0.109 0.109 post_ltx vs healthy 1 2087.993 7.806 0.037 0.001 0.002 **

pairs Df SumsOfSqs F.Model R2 p.value p.adjusted sig pre_ltx vs healthy 1 3.231 9.892 0.035 0.001 0.002 ** pre_ltx vs post_ltx 1 1.822 5.456 0.015 0.010 0.010 ** post_ltx vs healthy 1 4.004 12.790 0.059 0.001 0.002 **

pairs Df SumsOfSqs F.Model R2 p.value p.adjusted sig pre_ltx vs healthy 1 2.614 6.644 0.024 0.001 0.002 ** pre_ltx vs post_ltx 1 1.649 4.143 0.012 0.031 0.031 * post_ltx vs healthy 1 3.192 8.331 0.039 0.001 0.002 **

PCA

plot_list <- supplements_beta[grepl("PCoA",names(supplements_beta)) &
                              grepl(segment,names(supplements_beta))]

ggarrange(plotlist = plot_list,
          labels=names(plot_list),
          font.label = list(size=5,face="plain"),
          ncol=2,nrow=3)

Univariate analysis

Number of significant taxa

knitr::kable(cbind(as.data.frame(lapply(list_intersections,nrow)),
      as.data.frame(lapply(psc_effect,nrow))) %>% t() %>% 
  `colnames<-`("Count") %>% 
  `rownames<-`(c(names(list_intersections),"PSC effect ASV","PSC effect Genus","PSC effect Phylum")),caption="Number of significant taxa")

Number of significant taxa

	Count
colon genus healthy vs pre_ltx	29
colon genus pre_ltx vs post_ltx	0
colon genus healthy vs post_ltx	29
colon ASV healthy vs pre_ltx	21
colon ASV pre_ltx vs post_ltx	3
colon ASV healthy vs post_ltx	52
colon phylum healthy vs pre_ltx	2
colon phylum pre_ltx vs post_ltx	1
colon phylum healthy vs post_ltx	2
PSC effect ASV	22
PSC effect Genus	11
PSC effect Phylum	2

Counts

# univar_list <- univariate_statistics(list_intersections,
#                                      psc_effect,
#                                      colon_genus_asv_taxa_tab)
# 
# univar_df <- univar_list[[1]]
# wb <- univar_list[[2]]
# 
# # save the results
# saveWorkbook(wb,"results/Q1/DAA_final_terminal_colon.xlsx", overwrite = TRUE)
# 
# # see the results
# univar_df

Machine learning

Main models

Summary

knitr::kable(models_summ_df_colon %>% dplyr::select(
"alpha","lambda",
"auc_optimism_corrected",
"auc_optimism_corrected_CIL",
"auc_optimism_corrected_CIU"),
             digits=3,caption="Elastic net results")

Elastic net results

	alpha	lambda	auc_optimism_corrected	auc_optimism_corrected_CIL	auc_optimism_corrected_CIU
pre_ltx vs healthy ASV colon	0.6	0.006	0.900	0.863	0.955
pre_ltx vs post_ltx ASV colon	0.4	0.002	0.777	0.722	0.835
post_ltx vs healthy ASV colon	0.4	0.009	0.913	0.726	0.997
pre_ltx vs healthy genus colon	1.0	0.002	0.939	0.874	0.972
pre_ltx vs post_ltx genus colon	0.4	0.005	0.720	0.610	0.811
post_ltx vs healthy genus colon	0.2	0.001	0.944	0.853	0.992

ROC - ASV level

roc_curve_all_custom(roc_cs[c(7:9)], 
                     Q="Q1_norway",
                     model_name="enet_model")

ROC - Genus level

roc_curve_all_custom(roc_cs[c(10:12)],Q="Q1_norway",
                     model_name="enet_model")

Supplementary models

Summary

# Build final dataframe
models_list[["enet_model"]] <- rbind(models_summ_df_colon,models_summ_df_colon)
final_df <- tibble(row_names = rownames(models_list[[1]]))

# Loop through models and extract required values
for (model_name in names(models_list)) {
  model_df <- models_list[[model_name]]
  
  # Combine AUC_optimism_corrected with its CI values
  final_df[[model_name]] <- paste0(
    round(model_df$auc_optimism_corrected, 3), 
    " (", round(model_df$auc_optimism_corrected_CIL, 3), "; ", 
    round(model_df$auc_optimism_corrected_CIU, 3), ")"
  )
}

knitr::kable(final_df, caption="All models")

All models

row_names	knn_model	rf_model	gbm_model	enet_model_ra	knn_model_ra	rf_model_ra	gbm_model_ra	enet_model
pre_ltx vs healthy ASV terminal_ileum	0.869 (0.781; 0.922)	0.946 (0.829; 0.994)	0.927 (0.858; 0.995)	0.884 (0.77; 0.97)	0.892 (0.821; 0.942)	0.985 (0.955; 1)	0.944 (0.884; 0.997)	0.9 (0.863; 0.955)
pre_ltx vs post_ltx ASV terminal_ileum	0.773 (0.675; 0.879)	0.941 (0.89; 0.99)	0.927 (0.858; 0.995)	0.775 (0.569; 0.891)	0.596 (0.51; 0.731)	0.964 (0.919; 0.996)	0.944 (0.884; 0.997)	0.777 (0.722; 0.835)
post_ltx vs healthy ASV terminal_ileum	0.898 (0.779; 0.997)	0.926 (0.855; 1)	0.927 (0.858; 0.995)	0.879 (0.772; 0.995)	0.869 (0.781; 0.941)	0.906 (0.795; 0.999)	0.944 (0.884; 0.997)	0.913 (0.726; 0.997)
pre_ltx vs healthy genus terminal_ileum	0.892 (0.745; 0.964)	0.958 (0.854; 0.995)	0.927 (0.858; 0.995)	0.901 (0.812; 0.99)	0.838 (0.705; 0.939)	0.965 (0.852; 1)	0.944 (0.884; 0.997)	0.939 (0.874; 0.972)
pre_ltx vs post_ltx genus terminal_ileum	0.76 (0.655; 0.92)	0.93 (0.9; 0.956)	0.927 (0.858; 0.995)	0.647 (0.493; 0.836)	0.565 (0.426; 0.712)	0.974 (0.943; 1)	0.944 (0.884; 0.997)	0.72 (0.61; 0.811)
post_ltx vs healthy genus terminal_ileum	0.913 (0.857; 0.988)	0.927 (0.858; 0.995)	0.927 (0.858; 0.995)	0.9 (0.809; 0.986)	0.818 (0.746; 0.9)	0.944 (0.884; 0.997)	0.944 (0.884; 0.997)	0.944 (0.853; 0.992)
pre_ltx vs healthy ASV colon	0.776 (0.678; 0.846)	0.95 (0.889; 0.99)	0.922 (0.867; 0.962)	0.948 (0.899; 0.974)	0.854 (0.723; 0.935)	0.979 (0.934; 1)	0.949 (0.906; 0.999)	0.9 (0.863; 0.955)
pre_ltx vs post_ltx ASV colon	0.579 (0.534; 0.637)	0.681 (0.58; 0.747)	0.922 (0.867; 0.962)	0.62 (0.463; 0.703)	0.542 (0.46; 0.63)	0.716 (0.586; 0.805)	0.949 (0.906; 0.999)	0.777 (0.722; 0.835)
post_ltx vs healthy ASV colon	0.861 (0.757; 0.977)	0.87 (0.778; 0.952)	0.922 (0.867; 0.962)	0.933 (0.836; 0.995)	0.888 (0.842; 0.96)	0.927 (0.777; 0.997)	0.949 (0.906; 0.999)	0.913 (0.726; 0.997)
pre_ltx vs healthy genus colon	0.847 (0.761; 0.888)	0.889 (0.762; 0.95)	0.922 (0.867; 0.962)	0.932 (0.876; 0.968)	0.859 (0.781; 0.919)	0.929 (0.812; 0.987)	0.949 (0.906; 0.999)	0.939 (0.874; 0.972)
pre_ltx vs post_ltx genus colon	0.521 (0.424; 0.607)	0.679 (0.612; 0.76)	0.922 (0.867; 0.962)	0.569 (0.492; 0.71)	0.567 (0.495; 0.644)	0.671 (0.6; 0.727)	0.949 (0.906; 0.999)	0.72 (0.61; 0.811)
post_ltx vs healthy genus colon	0.899 (0.825; 0.988)	0.922 (0.867; 0.962)	0.922 (0.867; 0.962)	0.931 (0.829; 1)	0.876 (0.811; 0.957)	0.949 (0.906; 0.999)	0.949 (0.906; 0.999)	0.944 (0.853; 0.992)

write.csv(final_df,file=file.path(path,"AUC_all_models.csv"),row.names = FALSE)

ROC - ASV

rocs_list <- supplements_models$roc_cs
rocs_list[["enet_model"]] <- roc_cs

plot_list <- list()

for (model_name in names(rocs_list)) {
  plot_list[[model_name]] <- roc_curve_all_custom(rocs_list[[model_name]][c(1:3)],
                       Q="Q1_norway",
                       model_name=model_name)
}

ggarrange(plotlist = plot_list,labels = names(rocs_list),font.label = list(face="plain",size=7))

ROC - genus

plot_list <- list()

for (model_name in names(rocs_list)) {
  plot_list[[model_name]] <- roc_curve_all_custom(rocs_list[[model_name]][c(4:6)],
                       Q="Q1_norway",
                       model_name=model_name)
}

ggarrange(plotlist = plot_list,labels = names(rocs_list),font.label = list(face="plain",size=7))